ExcelVBA.Net sitesine katkıda bulunabilirsiniz

[JOSSEF]

Merhaba
Barkot etiketi yazdırma konusunda birde dosyadan userforma resim çekme konusunda sıkıştım kaldım. Dosyayı ekledim. sorunumu çözmemde yardımcı olur musunuz. Bu arada çözemediğim sorunlarla ilgili açıklamaları userforma yazdım.

Şimdiden teşekkür ederim.

https://dosya.co/syv6u48ljyuv/VOLANT_HASTANESİ_1.xlsm.html
[url=https://dosya.co/syv6u48ljyuv/VOLANT_HASTANESİ_1.xlsm.html]VOLANT HASTANESİ 1.xlsm - 107 KB[/url]

[JOSSEF]

linki günceleldim

https://dosya.co/syv6u48ljyuv/VOLANT_HASTANESİ_1.xlsm.html


[url=https://dosya.co/syv6u48ljyuv/VOLANT_HASTANESİ_1.xlsm.html]VOLANT HASTANESİ 1.xlsm - 107 KB[/url]

[JOSSEF]

https://dosya.co/syv6u48ljyuv/VOLANT_HA ... .xlsm.html
[url=https://dosya.co/syv6u48ljyuv/VOLANT_HASTANESİ_1.xlsm.html]VOLANT HASTANESI 1.xlsm - 107 KB[/url]

[JOSSEF]

en güncel hali
https://dosya.co/3qep6fevb9ak/volhast.xlsm.html

volhast.xlsm - 107 KB

[okutkan]

image1 e resim atmak için aşağıdaki kodu kullanabilirsiniz.

Kod: Tümünü seç


Image1.Picture = LoadPicture("D:\Pictures\YARDIMCI FOTOLAR\Logolar\" & TextBox1.Value & ".jpg")


[JOSSEF]

image1 e resim atmak için aşağıdaki kodu kullanabilirsiniz.

Kod: Tümünü seç


Image1.Picture = LoadPicture("D:\Pictures\YARDIMCI FOTOLAR\Logolar\" & TextBox1.Value & ".jpg")


Çok teşekkür ederim. harika çalıştı. Ufak bir sorun var. resmi buldu getirdi ama başka bir stok noya tıkladığımda ve o kodun resmi yoksa hala aynı resim kalıyor. o kodun resmi varsa sorun yok.

Sorunu çözmek için
Verdiğiniz kod ürünü resmi olmayan bir stok noya tıkladığımızda yine aynı dizinde bulunan "VH0000" nolu resmi getirmesini nasıl bir kodla sağlarız.

[okutkan]

Verdiğim kodu kullandığınız haliyle dosyayı buraya yükler misiniz.

[JOSSEF]

Ekledim efendim. Unutmadan kodlardan resimin konumunu dosyayı indirdiğiniz konuma göre ayarlamayı unutmayın.

ALIŞMA 23.11.2020.rar

[okutkan]

set s1 ....
son = ...
sat = ...
Yukarıdaki üç satırı bütün textbox özelikleri için kullanmışsınız. Birer tane kullanmanız yeterli. Listbox1_change bölümüne aşağıdaki kodu yapıştırın, eski kodun tamamını silebilirsiniz.

Kod: Tümünü seç

Private Sub ListBox1_Change()


If IsNull(ListBox1.Value) = True Then TextBox2.Text = "": Exit Sub '<-------------------
Set s1 = Sheets("SAHİBİNDEN")
son = s1.Cells(Rows.Count, "A").End(3).Row
sat = WorksheetFunction.Match(ListBox1.Value, s1.Range("A1:A" & son), 0)
' *************** TextBox2 VH KODU ***************
TextBox2.Text = s1.Cells(sat, "A")
' *************** TextBox3 PARÇANIN İSMİ ***************
TextBox3.Text = s1.Cells(sat, "B")
' *************** TextBox4 DURUMU ***************
TextBox4.Text = s1.Cells(sat, "C")
' *************** TextBox5 MARKASI ***************
TextBox5.Text = s1.Cells(sat, "D")
' *************** TextBox6 ORJİNAL PARÇA NO ***************
TextBox6.Text = s1.Cells(sat, "E")
' *************** TextBox7 ÜRETİCİ PARÇA NO ***************
TextBox7.Text = s1.Cells(sat, "F")
' *************** TextBox8 DEPODAKİ YERİ ***************
TextBox8.Text = s1.Cells(sat, "I")
On Error GoTo 10:
Image1.Picture = LoadPicture("D:\Pictures\YARDIMCI FOTOLAR\Logolar\" & TextBox2.Value & ".jpg")

Exit Sub
10:
Image1.Picture = LoadPicture("D:\Pictures\YARDIMCI FOTOLAR\Logolar\ERROR.jpg")

End Sub



[okutkan]

Bu arada siz fotoğraf resmini VH0000 isimli olarak istemişsiniz;kodda bulunan ERROR yazan yeri VH0000 olarak değiştirebilirsiniz.

[okutkan]

https://www.youtube.com/redirect?v=v_mhtAvkTro&event=video_description&redir_token=QUFFLUhqa0Vrc0l6TGcwdjV3RmZtbkhJQTd5QTMzRkd0UXxBQ3Jtc0tsSXlPeHNmQ3RLV1o3X2RCMzhucTRyUWstRUQwY01pMVRoYmJwZFM1SHR1SGdLYnhpTExrMnBNamZCYk5HdjNIb3pFVFRXbkZSbVJLYS0yUzM4cGtZcDQ0cXozbkNSc3VjS1E3VFVkM0J5cnN0Z1ZuOA%3D%3D&q=https%3A%2F%2Fdrive.google.com%2Fuc%3Fauthuser%3D0%26id%3D1Hi0iTJcH7uuci2LDJi_12G0W_SJ55mEH%26export%3Ddownload
Yukarıdaki yazı fontunu bilgisayara yükleyin.

Dosyanızdaki modül1 e aşağıdaki kodu yapıştırın.
Barkodun görünmesini istediğiniz hücreye =code yazdığınızda =code128$(VH0002) olarak karşına çıkan formülü kullanacaksın. VH0002 yerine hücreyi hedef gösterebilirsin.
Herhangi bir siteye ihtiyaç duymadan bu şekilde barkodunu üretebilirsiniz. Bu arada =code128 formülünü kullandığınız hücrenin yazı fontunu da code128 olarak ayarlayın.

Kod: Tümünü seç

Public Function code128$(chaine$)

  Dim i%, checksum&, mini%, dummy%, tableB As Boolean
  code128$ = ""
  If Len(chaine$) > 0 Then
  'Check for valid characters
    For i% = 1 To Len(chaine$)
      Select Case Asc(Mid$(chaine$, i%, 1))
      Case 32 To 126, 203
      Case Else
        i% = 0
        Exit For
      End Select
    Next
    'Calculation of the code string with optimized use of tables B and C
    code128$ = ""
    tableB = True
    If i% > 0 Then
      i% = 1 'i% devient l'index sur la chaine / i% become the string index
      Do While i% <= Len(chaine$)
        If tableB Then
          'See if interesting to switch to table C
          'yes for 4 digits at start or end, else if 6 digits
          mini% = IIf(i% = 1 Or i% + 3 = Len(chaine$), 4, 6)
          GoSub testnum
          If mini% < 0 Then 'Choice of table C
            If i% = 1 Then 'Starting with table C
              code128$ = Chr$(205)
            Else 'Switch to table C
              code128$ = code128$ & Chr$(199)
            End If
            tableB = False
          Else
            If i% = 1 Then code128$ = Chr$(204) 'Starting with table B
          End If
        End If
        If Not tableB Then
          'We are on table C, try to process 2 digits
          mini% = 2
          GoSub testnum
          If mini% < 0 Then 'OK for 2 digits, process it
            dummy% = Val(Mid$(chaine$, i%, 2))
            dummy% = IIf(dummy% < 95, dummy% + 32, dummy% + 100)
            code128$ = code128$ & Chr$(dummy%)
            i% = i% + 2
          Else 'We haven't 2 digits, switch to table B
            code128$ = code128$ & Chr$(200)
            tableB = True
          End If
        End If
        If tableB Then
          'Process 1 digit with table B
          code128$ = code128$ & Mid$(chaine$, i%, 1)
          i% = i% + 1
        End If
      Loop
      'Calculation of the checksum
      For i% = 1 To Len(code128$)
        dummy% = Asc(Mid$(code128$, i%, 1))
        dummy% = IIf(dummy% < 127, dummy% - 32, dummy% - 100)
        If i% = 1 Then checksum& = dummy%
        checksum& = (checksum& + (i% - 1) * dummy%) Mod 103
      Next
      'Calculation of the checksum ASCII code
      checksum& = IIf(checksum& < 95, checksum& + 32, checksum& + 100)
      'Add the checksum and the STOP
      code128$ = code128$ & Chr$(checksum&) & Chr$(206)
    End If
  End If
  Exit Function
testnum:
  'if the mini% characters from i% are numeric, then mini%=0
  mini% = mini% - 1
  If i% + mini% <= Len(chaine$) Then
    Do While mini% >= 0
      If Asc(Mid$(chaine$, i% + mini%, 1)) < 48 Or Asc(Mid$(chaine$, i% + mini%, 1)) > 57 Then Exit Do
      mini% = mini% - 1
    Loop
  End If
Return
End Function





[okutkan]

Açtığınız bu konuyu takibi bırakmayıp takibe devam ederseniz, projenizi bi kaç günde istediğiniz hale getirebiliriz. Konu hakkında bilgim olmadığı için araştırarak yardımcı olmaya çalışıyorum. Birde işlerimden fırsat buldukça bakabiliyorum. Verdiğim kodları projenize uygulayamadığınız noktaları belirtirseniz, projeye yerleştirip dosyayı paylaşırım. İyi geceler.

[okutkan]

Yüklediğim dosyadaki yazı fontunu açın ve bilgisayara yükleyin.

Bilgileri etikete yazdır sayfasına at butonuna bastığınızda, belirtilen sayfaya bilgileri atar ve barkodu oluşturur. Userform üzerindeki label üzerinde de bir adet barkod oluşturur. Barkod oluşturma işlemini internete bağlanma ihtayacı duymadan gerçekleştirir. Eksikliğini gördüğünüz başla bir konu varsa yazarsanız 1-2 gün içinde tekrar yardımcı olurum.

Bu arada barkodlar font olarak oluşturuluyor, resim olarak değil. Kontrol ettim doğru bir şekilde barkod veriyordu.

[okutkan]

VH0003-MAPA gibi kodlara çok uzun barkodlar çıktığını farkettim. "Etiket Yazdırma" Sayfasındaki hücreye barkod sığmadığı için aşağı satıra geçiyor. Bunu engellemek için yazı font büyüklüğünü 72 den 50 ye düşürebilirsiniz.

Userform üzerindeki label'e de barkodun sığmadığını farkettim. Labeli userformun sağ tarafına doğru uzatırsanız tüm barkodlar sığacaktır.