Barkod ile ilgili yardım

E

excel5252

Altın Üye
Katılım
19 Ocak 2021
Mesajlar
47
Excel Vers. ve Dili
microsoft office 2019 tr 2004 olan seri son sürüm
Altın Üyelik Bitiş Tarihi
07-12-2028
Çok değerli Üstadlarım ekteki barkodla ilgili sorum şu ben ismi belirtilen barkoda nasıl yazdıra bilirim. Sütun E deki barkoda üstüne veya altın barkoda etki etmeden nasıl isim yazdıra bilirim. Şimdiden yardımlarınız için çok teşekkür ederim.
 

Ekli dosyalar

airborne

airborne

Katılım
20 Ekim 2005
Mesajlar
499
s.a.

Kod: 
Sub BarkodVeIsim()
    Dim i As Long
    Dim barkod As String, isim As String
   
    For i = 2 To Cells(Rows.Count, "E").End(xlUp).Row
        barkod = Cells(i, "E").Value
        isim = Cells(i, "F").Value ' Ürün isimleri F sütununda olsun
        Cells(i, "E").Value = barkod & vbNewLine & isim
        Cells(i, "E").WrapText = True
    Next i
End Sub
E sütununda barkod var.
F sütununda isim var.
Makro, E sütununa barkod + isim alt alta yazar.

Barkod fontunu ilk satıra elle uygularsan, isim normal fontta kalır.
 
E

excel5252

Altın Üye
Katılım
19 Ocak 2021
Mesajlar
47
Excel Vers. ve Dili
microsoft office 2019 tr 2004 olan seri son sürüm
Altın Üyelik Bitiş Tarihi
07-12-2028
airborne' Alıntı:
s.a.

Kod: 
Sub BarkodVeIsim()
    Dim i As Long
    Dim barkod As String, isim As String
  
    For i = 2 To Cells(Rows.Count, "E").End(xlUp).Row
        barkod = Cells(i, "E").Value
        isim = Cells(i, "F").Value ' Ürün isimleri F sütununda olsun
        Cells(i, "E").Value = barkod & vbNewLine & isim
        Cells(i, "E").WrapText = True
    Next i
End Sub
E sütununda barkod var.
F sütununda isim var.
Makro, E sütununa barkod + isim alt alta yazar.

Barkod fontunu ilk satıra elle uygularsan, isim normal fontta kalır.
Genişletmek için tıkla ...
sana zahmet olmaz ise bana makrolu şekilde verirmisin şimdiden teşekkür ederim.
 
E

excel5252

Altın Üye
Katılım
19 Ocak 2021
Mesajlar
47
Excel Vers. ve Dili
microsoft office 2019 tr 2004 olan seri son sürüm
Altın Üyelik Bitiş Tarihi
07-12-2028
üstadlar ben kitap birdeki barkod olan yeri yazdırırken adını nasıl yazdırta bilirim.
 
N

nihatkr

Altın Üye
Altın Üye
Katılım
25 Ağustos 2006
Mesajlar
522
Excel Vers. ve Dili
2016 Türkçe
Ofis 365
Altın Üyelik Bitiş Tarihi
09.10.2029
N

nihatkr

Altın Üye
Altın Üye
Katılım
25 Ağustos 2006
Mesajlar
522
Excel Vers. ve Dili
2016 Türkçe
Ofis 365
Altın Üyelik Bitiş Tarihi
09.10.2029
excel5252' Alıntı:
üstadlar ben kitap birdeki barkod olan yeri yazdırırken adını nasıl yazdırta bilirim.
Genişletmek için tıkla ...
Sizden Cevap Gelmedi ama anladığım Kadarıyla.. Geri dönüş Yapınki Çözüm mü Değilmi? bilelim
 

Ekli dosyalar

Son düzenleme:
E

excel5252

Altın Üye
Katılım
19 Ocak 2021
Mesajlar
47
Excel Vers. ve Dili
microsoft office 2019 tr 2004 olan seri son sürüm
Altın Üyelik Bitiş Tarihi
07-12-2028
nihatkr' Alıntı:
Sizden Cevap Gelmedi ama anladığım Kadarıyla.. Geri dönüş Yapınki Çözüm mü Değilmi? bilelim
Genişletmek için tıkla ...
Kusura kalma bugün gördüm
ben tablodaki borkod olan yerdeki kısmı yazdırırken üstüne veya alt kısma ismi nasıl yazdıra bilirim
 
E

excel5252

Altın Üye
Katılım
19 Ocak 2021
Mesajlar
47
Excel Vers. ve Dili
microsoft office 2019 tr 2004 olan seri son sürüm
Altın Üyelik Bitiş Tarihi
07-12-2028
nihatkr' Alıntı:
Son Gönderiğim dosya Bunu Yapıyor 10. Mesaj
Genişletmek için tıkla ...
peki üstad bunu nasıl çoğalta biliriz yani kişi sayısı 1500 geçerse nasıl olur farklı kişilerde oluyor mu.çünkü ben bunu başka bir listeyi kopyalayıp verdiğiniz programda end debug hatasında run time erro 404 hatası veriyor debug deyince de
wsHedef.Paste hatası ile sonuçlanıyor. şimdiden teşekkür ederim.
 
N

nihatkr

Altın Üye
Altın Üye
Katılım
25 Ağustos 2006
Mesajlar
522
Excel Vers. ve Dili
2016 Türkçe
Ofis 365
Altın Üyelik Bitiş Tarihi
09.10.2029
excel5252' Alıntı:
peki üstad bunu nasıl çoğalta biliriz yani kişi sayısı 1500 geçerse nasıl olur farklı kişilerde oluyor mu.çünkü ben bunu başka bir listeyi kopyalayıp verdiğiniz programda end debug hatasında run time erro 404 hatası veriyor debug deyince de
wsHedef.Paste hatası ile sonuçlanıyor. şimdiden teşekkür ederim.
Genişletmek için tıkla ...
Aslında Tüm Satırları kontrol ediyor. Ama Boş Staırlar Olunca Hata Veriyor.

Modül 3 teki kodu aşağıdaki KOD'la değiştirin sorun kalmayacak. (Test ettim çalışıyor sorun yok. Hem Bu Kod Hem Seçmeli Kod)

Sub TumListeBarkodTekResim()
Dim wsKaynak As Worksheet, wsHedef As Worksheet
Dim lastRow As Long, i As Long
Dim urunAdi As String, barkod As String
Dim imgURL As String
Dim tmpShp As Shape
Dim yeniSayfaAd As String
Dim pic As Picture
Dim tempFile As String

Set wsKaynak = ActiveSheet
yeniSayfaAd = "BarkodlarTekResim"

On Error Resume Next
Application.DisplayAlerts = False
Worksheets(yeniSayfaAd).Delete
Application.DisplayAlerts = True
On Error GoTo 0

Set wsHedef = Worksheets.Add
wsHedef.Name = yeniSayfaAd
wsHedef.Cells.Clear

wsHedef.Cells(1, 1).Value = "Ürün ve Barkod"
wsHedef.Rows(1).Font.Bold = True
wsHedef.Rows(1).RowHeight = 30

lastRow = wsKaynak.Cells(wsKaynak.Rows.Count, "A").End(xlUp).Row

Application.ScreenUpdating = False

For i = 2 To lastRow
urunAdi = wsKaynak.Cells(i, 1).Value
barkod = wsKaynak.Cells(i, 5).Value


If Trim(urunAdi) = "" Or Trim(barkod) = "" Then GoTo Sonraki

imgURL = "https://barcode.tec-it.com/barcode.ashx?data=" & barkod & _
"&code=Code128&multiplebarcodes=false&translate-esc=false&unit=Fit&dpi=96"


tempFile = Environ("TEMP") & "\tmpbarkod.png"


Dim WinHttp As Object
Set WinHttp = CreateObject("MSXML2.XMLHTTP")
WinHttp.Open "GET", imgURL, False
WinHttp.Send

If WinHttp.Status = 200 Then
Dim stream As Object
Set stream = CreateObject("ADODB.Stream")
stream.Type = 1
stream.Open
stream.Write WinHttp.responseBody
stream.SaveToFile tempFile, 2
stream.Close


Set tmpShp = wsHedef.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 200, 60)
With tmpShp
.TextFrame.Characters.Text = urunAdi
.TextFrame.HorizontalAlignment = xlHAlignCenter
.TextFrame.VerticalAlignment = xlVAlignTop
.Line.Visible = msoFalse
.Fill.Visible = msoFalse
End With


Set pic = wsHedef.Pictures.Insert(tempFile)
With pic
.Top = tmpShp.Top + 20
.Left = tmpShp.Left + 10
.ShapeRange.LockAspectRatio = msoTrue
.Height = 40
End With


wsHedef.Shapes.Range(Array(tmpShp.Name, pic.Name)).Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
wsHedef.Cells(i, 1).Select
wsHedef.Paste


tmpShp.Delete
pic.Delete


Kill tempFile

wsHedef.Rows(i).RowHeight = 60
End If

Sonraki:
Next i

Application.ScreenUpdating = True
MsgBox "Tüm barkodlar tek resim olarak '" & yeniSayfaAd & "' sayfasına eklendi!", vbInformation
End Sub
 
E

excel5252

Altın Üye
Katılım
19 Ocak 2021
Mesajlar
47
Excel Vers. ve Dili
microsoft office 2019 tr 2004 olan seri son sürüm
Altın Üyelik Bitiş Tarihi
07-12-2028
nihatkr' Alıntı:
Aslında Tüm Satırları kontrol ediyor. Ama Boş Staırlar Olunca Hata Veriyor.

Modül 3 teki kodu aşağıdaki KOD'la değiştirin sorun kalmayacak. (Test ettim çalışıyor sorun yok. Hem Bu Kod Hem Seçmeli Kod)

Sub TumListeBarkodTekResim()
Dim wsKaynak As Worksheet, wsHedef As Worksheet
Dim lastRow As Long, i As Long
Dim urunAdi As String, barkod As String
Dim imgURL As String
Dim tmpShp As Shape
Dim yeniSayfaAd As String
Dim pic As Picture
Dim tempFile As String

Set wsKaynak = ActiveSheet
yeniSayfaAd = "BarkodlarTekResim"

On Error Resume Next
Application.DisplayAlerts = False
Worksheets(yeniSayfaAd).Delete
Application.DisplayAlerts = True
On Error GoTo 0

Set wsHedef = Worksheets.Add
wsHedef.Name = yeniSayfaAd
wsHedef.Cells.Clear

wsHedef.Cells(1, 1).Value = "Ürün ve Barkod"
wsHedef.Rows(1).Font.Bold = True
wsHedef.Rows(1).RowHeight = 30

lastRow = wsKaynak.Cells(wsKaynak.Rows.Count, "A").End(xlUp).Row

Application.ScreenUpdating = False

For i = 2 To lastRow
urunAdi = wsKaynak.Cells(i, 1).Value
barkod = wsKaynak.Cells(i, 5).Value


If Trim(urunAdi) = "" Or Trim(barkod) = "" Then GoTo Sonraki

imgURL = "https://barcode.tec-it.com/barcode.ashx?data=" & barkod & _
"&code=Code128&multiplebarcodes=false&translate-esc=false&unit=Fit&dpi=96"


tempFile = Environ("TEMP") & "\tmpbarkod.png"


Dim WinHttp As Object
Set WinHttp = CreateObject("MSXML2.XMLHTTP")
WinHttp.Open "GET", imgURL, False
WinHttp.Send

If WinHttp.Status = 200 Then
Dim stream As Object
Set stream = CreateObject("ADODB.Stream")
stream.Type = 1
stream.Open
stream.Write WinHttp.responseBody
stream.SaveToFile tempFile, 2
stream.Close


Set tmpShp = wsHedef.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, 200, 60)
With tmpShp
.TextFrame.Characters.Text = urunAdi
.TextFrame.HorizontalAlignment = xlHAlignCenter
.TextFrame.VerticalAlignment = xlVAlignTop
.Line.Visible = msoFalse
.Fill.Visible = msoFalse
End With


Set pic = wsHedef.Pictures.Insert(tempFile)
With pic
.Top = tmpShp.Top + 20
.Left = tmpShp.Left + 10
.ShapeRange.LockAspectRatio = msoTrue
.Height = 40
End With


wsHedef.Shapes.Range(Array(tmpShp.Name, pic.Name)).Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
wsHedef.Cells(i, 1).Select
wsHedef.Paste


tmpShp.Delete
pic.Delete


Kill tempFile

wsHedef.Rows(i).RowHeight = 60
End If

Sonraki:
Next i

Application.ScreenUpdating = True
MsgBox "Tüm barkodlar tek resim olarak '" & yeniSayfaAd & "' sayfasına eklendi!", vbInformation
End Sub
Genişletmek için tıkla ...
çok teşekkür ederim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst