Merhaba
Konuyu forumda arattım. Bir kaç örnek buldum ama nasıl yapacağımı bulamadım. B2 hücresinde entera basınca A2 ve B2 hücresinde sayı değeri girilmişse etiketbas adlı makroyu çalıştırsın hücrelerden 1i yada her ikisi boşsa veya sayısal olmayan bir değer girilmişse çalışmasın istiyorum. Bunu nasıl yapabilirim? Yardımcı olursanız çok sevinirim.
Makro kodlarım bunlar
Konuyu forumda arattım. Bir kaç örnek buldum ama nasıl yapacağımı bulamadım. B2 hücresinde entera basınca A2 ve B2 hücresinde sayı değeri girilmişse etiketbas adlı makroyu çalıştırsın hücrelerden 1i yada her ikisi boşsa veya sayısal olmayan bir değer girilmişse çalışmasın istiyorum. Bunu nasıl yapabilirim? Yardımcı olursanız çok sevinirim.
Makro kodlarım bunlar
Kod:
'kod başladı Yavuz YILMAZ
Sub etiketbas()
Dim Varsayilan_Printer, cevap, makno, baz, barkod, adetn, adett As String
Dim etiketadet, say, satir As Integer
'etiket sayfasını temizledim :)
Sayfa2.Columns("A:C").ClearContents
yaz = 2
For a = 2 To Sayfa1.Range("A10000").End(xlUp).Row
Sayac = 1
For i = 1 To Sayfa1.Cells(a, "E")
Sayfa2.Range("A" & yaz) = Sayfa1.Cells(a, "C")
Sayfa2.Range("B" & yaz) = Sayfa1.Cells(a, "D") & "-" & IIf(Sayac >= 10, "N", "N0") & Sayac
With Sayfa2.Range("B" & yaz).Font
.Size = 18
End With
Sayfa2.Range("C" & yaz) = Sayfa1.Cells(a, "F")
yaz = Sayfa2.Range("B10000").End(3).Row + 2
Sayac = Sayac + 1
Next i
Sayac = 1
For x = 1 To Sayfa1.Cells(a, "B")
Sayfa2.Range("A" & yaz) = Sayfa1.Cells(a, "C")
Sayfa2.Range("B" & yaz) = Sayfa1.Cells(a, "D")
With Sayfa2.Range("B" & yaz).Font
.Size = 28
End With
Sayfa2.Range("C" & yaz) = Sayfa1.Cells(a, "F")
yaz = Sayfa2.Range("B10000").End(3).Row + 2
Sayac = Sayac + 1
Next x
Next a
yaz = 1
For b = 2 To Sayfa1.Range("A10000").End(xlUp).Row
Sayac = 1
For y = 1 To Sayfa1.Cells(b, "E") + Sayfa1.Cells(b, "B")
makno = Sheets("veri").Range("C1").Value
baz = Sheets("veri").Range("D1").Value
barkod = Sheets("rapor").Range("A1").Value
Sayfa2.Range("A" & yaz) = makno
Sayfa2.Range("B" & yaz) = baz
Sayfa2.Range("C" & yaz) = barkod
yaz = yaz + 2
Sayac = Sayac + 1
Next y
Next b
'kullacıya basalimmi dedim:)
cevap = MsgBox("Etiket hazir, baski yapilsin mi ?", vbYesNo + vbQuestion, "Onay Penceresi")
If cevap = vbNo Then
MsgBox ("Islem iptal edildi.")
Exit Sub
Else
Sheets("veri").Select
Range("C2,D2").Select
Selection.Copy
Sheets("rapor").Select
Cells(Rows.Count, 3).End(3)(2, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("veri").Select
Range("B2").Select
Selection.Copy
Sheets("rapor").Select
Cells(Rows.Count, 5).End(3)(2, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("veri").Select
Range("A2").Select
Selection.Copy
Sheets("rapor").Select
Cells(Rows.Count, 1).End(3)(2, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("veri").Select
Range("G2").Select
Selection.Copy
Sheets("rapor").Select
Cells(Rows.Count, 2).End(3)(2, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'yazdirma islemi yapiyorum
Sheets("etiket").Select
Columns("A:C").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
'Sayfaya geri dönüş :)
Sheets("veri").Select
Range("A2").Select
'Yazdırma tamam mesajı
MsgBox ("Yazdirma islemi ve veri kaydi tamamlandi.")
ActiveWorkbook.Save
End If
End Sub
