• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

YAZDIRMADAN ÖNCE BİLGİ EKRANI

musa yüksel

Altın Üye
Katılım
27 Şubat 2014
Mesajlar
98
Excel Vers. ve Dili
2016 tr
Merhaba ,
makro butonun bastığım zaman bilgi ekranı çıksın istiyorum
YAZDIRMAK İSTİYOR MUSUN ?
EVET HAYIR
EVET basıldığında makro çalışsın
HAYIR basıldığında makro çalışmasın

Kod:
Sub YAZDIRUSD()
'
' YAZDIRUSD Makro
'

'
    Sheets("USD YAZDIR").Select
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = "$A$2:$L$39"
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA5
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
End Sub
 
Merhaba

MsgBox("Yazdırmak istiyor musnuz?", vbYesNo) = vbNo Then Exit Sub
 
merhaba
aşağıda ki ile sorunumu çözdüm , ihtiyacı olan için paylaşmak istedim
noktalı yere çalıştırmak istediğiniz makroyu yapıştırarak kullanabilirsiniz

Kod:
Sub mesaj()
YesNo = MsgBox("Bu makroyu çalıştırmak istiyor musunuz?", vbYesNo + vbCritical, "Soru Başlığı")
Select Case YesNo
Case vbYes
MsgBox "Makro çalıştırıldı.", vbMsgBoxRtlReading

.
.
.
.
.
.
.


Case vbNo
MsgBox "Makroyu iptal ettiniz.", vbMsgBoxSetForeground
End Select
End Sub
 
Geri
Üst