1 sayfadan 1. sayfa

Barkot etiketi yazdırma dosyadan userforma resim çekme

İletiTarih: 22 Kas 2020 03:06
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]

Cevap: Barkot etiketi yazdırma dosyadan userforma resim çek

İletiTarih: 22 Kas 2020 03:09
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]

Cevap: Barkot etiketi yazdırma dosyadan userforma resim çek

İletiTarih: 22 Kas 2020 03:10
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]

Cevap: Barkot etiketi yazdırma dosyadan userforma resim çek

İletiTarih: 22 Kas 2020 03:13
JOSSEF

Cevap: Barkot etiketi yazdırma dosyadan userforma resim çek

İletiTarih: 22 Kas 2020 19:25
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")

Cevap: Cevap: Barkot etiketi yazdırma dosyadan userforma re

İletiTarih: 22 Kas 2020 22:27
JOSSEF
okutkan yazdı: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.

Cevap: Barkot etiketi yazdırma dosyadan userforma resim çek

İletiTarih: 22 Kas 2020 23:01
okutkan
Verdiğim kodu kullandığınız haliyle dosyayı buraya yükler misiniz.

Cevap: Barkot etiketi yazdırma dosyadan userforma resim çek

İletiTarih: 23 Kas 2020 00:53
JOSSEF
Ekledim efendim. Unutmadan kodlardan resimin konumunu dosyayı indirdiğiniz konuma göre ayarlamayı unutmayın.
ALIŞMA 23.11.2020.rar

Cevap: Barkot etiketi yazdırma dosyadan userforma resim çek

İletiTarih: 23 Kas 2020 01:08
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


Cevap: Barkot etiketi yazdırma dosyadan userforma resim çek

İletiTarih: 23 Kas 2020 01:10
okutkan
Bu arada siz fotoğraf resmini VH0000 isimli olarak istemişsiniz;kodda bulunan ERROR yazan yeri VH0000 olarak değiştirebilirsiniz.

Cevap: Barkot etiketi yazdırma dosyadan userforma resim çek

İletiTarih: 23 Kas 2020 02:07
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




Cevap: Barkot etiketi yazdırma dosyadan userforma resim çek

İletiTarih: 23 Kas 2020 02:17
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.

Cevap: Barkot etiketi yazdırma dosyadan userforma resim çek

İletiTarih: 23 Kas 2020 03:24
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.


Resim

Cevap: Barkot etiketi yazdırma dosyadan userforma resim çek

İletiTarih: 23 Kas 2020 03:35
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.