[Yardım]  Barkot etiketi yazdırma dosyadan userforma resim çekme

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

Barkot etiketi yazdırma dosyadan userforma resim çekme

İleti#1)  JOSSEF » 22 Kas 2020 03:06

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]
Kullanıcı avatarı
JOSSEF
Yeni Başlamış
 
Kayıt: 20 Haz 2020 09:02
Meslek: ESNAF
Yaş: 39
İleti: 20
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İZMİR

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

İleti#2)  JOSSEF » 22 Kas 2020 03:09

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]
Kullanıcı avatarı
JOSSEF
Yeni Başlamış
 
Kayıt: 20 Haz 2020 09:02
Meslek: ESNAF
Yaş: 39
İleti: 20
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İZMİR

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

İleti#3)  JOSSEF » 22 Kas 2020 03:10

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]
Kullanıcı avatarı
JOSSEF
Yeni Başlamış
 
Kayıt: 20 Haz 2020 09:02
Meslek: ESNAF
Yaş: 39
İleti: 20
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İZMİR

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

İleti#4)  JOSSEF » 22 Kas 2020 03:13

Kullanıcı avatarı
JOSSEF
Yeni Başlamış
 
Kayıt: 20 Haz 2020 09:02
Meslek: ESNAF
Yaş: 39
İleti: 20
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İZMİR

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

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

İleti#5)  okutkan » 22 Kas 2020 19:25

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")
Kullanıcı avatarı
okutkan
Yeni Başlamış
 
Kayıt: 27 May 2017 02:45
Meslek: pol. mem.
Yaş: 28
İleti: 94
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: DENİZLİ

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

İleti#6)  JOSSEF » 22 Kas 2020 22:27

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.
Kullanıcı avatarı
JOSSEF
Yeni Başlamış
 
Kayıt: 20 Haz 2020 09:02
Meslek: ESNAF
Yaş: 39
İleti: 20
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İZMİR

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

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

İleti#7)  okutkan » 22 Kas 2020 23:01

Verdiğim kodu kullandığınız haliyle dosyayı buraya yükler misiniz.
Kullanıcı avatarı
okutkan
Yeni Başlamış
 
Kayıt: 27 May 2017 02:45
Meslek: pol. mem.
Yaş: 28
İleti: 94
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: DENİZLİ

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

İleti#8)  JOSSEF » 23 Kas 2020 00:53

Ekledim efendim. Unutmadan kodlardan resimin konumunu dosyayı indirdiğiniz konuma göre ayarlamayı unutmayın.
ALIŞMA 23.11.2020.rar
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
JOSSEF
Yeni Başlamış
 
Kayıt: 20 Haz 2020 09:02
Meslek: ESNAF
Yaş: 39
İleti: 20
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İZMİR

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

İleti#9)  okutkan » 23 Kas 2020 01:08

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

Kullanıcı avatarı
okutkan
Yeni Başlamış
 
Kayıt: 27 May 2017 02:45
Meslek: pol. mem.
Yaş: 28
İleti: 94
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: DENİZLİ

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

İleti#10)  okutkan » 23 Kas 2020 01:10

Bu arada siz fotoğraf resmini VH0000 isimli olarak istemişsiniz;kodda bulunan ERROR yazan yeri VH0000 olarak değiştirebilirsiniz.
Kullanıcı avatarı
okutkan
Yeni Başlamış
 
Kayıt: 27 May 2017 02:45
Meslek: pol. mem.
Yaş: 28
İleti: 94
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: DENİZLİ

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

İleti#11)  okutkan » 23 Kas 2020 02:07

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



Kullanıcı avatarı
okutkan
Yeni Başlamış
 
Kayıt: 27 May 2017 02:45
Meslek: pol. mem.
Yaş: 28
İleti: 94
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: DENİZLİ

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

İleti#12)  okutkan » 23 Kas 2020 02:17

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.
Kullanıcı avatarı
okutkan
Yeni Başlamış
 
Kayıt: 27 May 2017 02:45
Meslek: pol. mem.
Yaş: 28
İleti: 94
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: DENİZLİ

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

İleti#13)  okutkan » 23 Kas 2020 03:24

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
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
okutkan
Yeni Başlamış
 
Kayıt: 27 May 2017 02:45
Meslek: pol. mem.
Yaş: 28
İleti: 94
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: DENİZLİ

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

İleti#14)  okutkan » 23 Kas 2020 03:35

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.
Kullanıcı avatarı
okutkan
Yeni Başlamış
 
Kayıt: 27 May 2017 02:45
Meslek: pol. mem.
Yaş: 28
İleti: 94
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: DENİZLİ


Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: Google [Bot] ve 2 misafir

Bumerang - Yazarkafe