yazdır demeden önce açıklama isteme.

[orange4609]

Merhabalar,

aşağıdaki koda yazdır demeden önce "sipariş numarası girmediniz"diye uyardıktan sonra sipariş numarası girilecek alan ve bu alana yazılan bilgi a8 hücresine atılacak bir kod ilave edebilirmiyiz.

Sub Makro4()
'
' Makro4 Makro
'

'
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A1:A8").Select
With Selection.Font
.Size = 20
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
End With
Range("A1:A8").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Varsayilan_Printer = Application.ActivePrinter
Adres = ActiveWindow.RangeSelection.Address
If InStr(Trim(Adres), ":") = 0 Then MsgBox "Yazdırılacak alan seçimi yapmadınız!": Exit Sub
Onay = MsgBox("Yazdırma işlemine devam etmek istiyor musunuz?", vbYesNo, "Uyarı")
If Onay = vbYes Then
adet = Application.InputBox("Kaç adet yazılacak.", "Yazdırma sayısı", "1", 400, 30, , Type:=1)
If adet = False Then
MsgBox "İşlemi iptal ettiniz"
Exit Sub
End If
Application.ActivePrinter = "Ne01: üzerindeki \\B0484\TEC B-SA4G "
Worksheets(ActiveSheet.Name).PageSetup.PrintArea = Adres
Worksheets(ActiveSheet.Name).PrintOut Copies:=adet, Collate:=True
End If
Application.ActivePrinter = Varsayilan_Printer
End Sub