üstüne kayıt yaparken sorma işlemi için koda ilave

[euphrates55]

aşağıdaki koda ne eklersem, eğer aynı isimde bir pdf varsa, değiştirmek istermisin diye sorar. bu hali ile sorgusuz üstüne kayıt yapıyor.

Sub PrintAllSheetsToPDF()
'SUBROUTINE: PrintAllSheetsToPDF
'DEVELOPER: Ryan Wells
'DESCRIPTION: Combine all your worksheets into one PDF
Dim strSheets() As String
Dim strfile As String
Dim sh As Worksheet
Dim icount As Integer
Dim myfile As Variant
Set GR = Sheets("GİRİŞLER")
'Save Chart Sheet names to an Array
For Each sh In ActiveWorkbook.Worksheets
If sh.Visible = xlSheetVisible Then
ReDim Preserve strSheets(icount)
strSheets(icount) = sh.Name
icount = icount + 1
End If
Next sh
If icount = 0 Then 'No charts found. Punch error
MsgBox "DOSYA OLUŞTURULAMIYOR, OLUŞTURULACAK SAYFA YOK.", , "SAYFA BULUNAMADI"
Exit Sub
End If
'Prompt for save location
strfile = GR.[c3].Value & " AYI HARCIRAH VE OLURLARI " _
& Format(Now(), "DD.MM.YYYY") _
& ".pdf"
strfile = ThisWorkbook.Path & "\" & strfile
myfile = Application.GetSaveAsFilename _
(InitialFileName:=strfile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="NEREYE KAYDEDECEKSEN SEÇ")
If myfile <> "False" Then 'save as PDF
ThisWorkbook.Sheets(strSheets).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
myfile, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
GR.Select
Else
MsgBox "Sen Bilirsin", vbOKOnly, "Vazgeçtin"
End If
End Sub

 

[ÖmerBey]

Merhaba,
Kodunuza ilave edip deneyiniz.

.
.
If myfile <> "False" Then 'save as PDF
If Dir(myfile) <> "" Then
    onay = MsgBox(myfile & vbLf & "dosyası zaten var, üzerine yazılsın mı?", vbYesNo)
    If onay = vbYes Then
        ThisWorkbook.Sheets(strSheets).Select
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        myfile, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=True
        GR.Select
    Else
        Exit Sub
    End If
End If
Else
.
.

 

[euphrates55]

teşekkürler Ömer Bey

 

[ÖmerBey]

Rica ederim,
Deneme fırsatım olmadı ama umarım çalışmıştır.
İyi çalışmalar...

 

[euphrates55]

Rica ederim,
Deneme fırsatım olmadı ama umarım çalışmıştır.
İyi çalışmalar...

aslında çalışmadı ama yormak istemedim... aklıma & Format(Now(), "(DD.MM.YYYY)_hh'mm'ss") çözümü geldi.

 

[ÖmerBey]

Denedim oldu, yada ben yapmak istediğinizi yanlış anladım.
Çıkan soruya evet derseniz kayıt işlemi yapar, hayır derseniz kodu sonlandırır.

Sub PrintAllSheetsToPDF()
'SUBROUTINE: PrintAllSheetsToPDF
'DEVELOPER: Ryan Wells
'DESCRIPTION: Combine all your worksheets into one PDF
Dim strSheets() As String
Dim strfile As String
Dim sh As Worksheet
Dim icount As Integer
Dim myfile As Variant
Set GR = Sheets("GİRİŞLER")
'Save Chart Sheet names to an Array
For Each sh In ActiveWorkbook.Worksheets
If sh.Visible = xlSheetVisible Then
ReDim Preserve strSheets(icount)
strSheets(icount) = sh.Name
icount = icount + 1
End If
Next sh
If icount = 0 Then 'No charts found. Punch error
MsgBox "DOSYA OLUŞTURULAMIYOR, OLUŞTURULACAK SAYFA YOK.", , "SAYFA BULUNAMADI"
Exit Sub
End If
'Prompt for save location
strfile = GR.[c3].Value & " AYI HARCIRAH VE OLURLARI " _
& Format(Now(), "DD.MM.YYYY") _
& ".pdf"
strfile = ThisWorkbook.Path & "\" & strfile
myfile = Application.GetSaveAsFilename _
(InitialFileName:=strfile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="NEREYE KAYDEDECEKSEN SEÇ")
If myfile <> "False" Then 'save as PDF
If Dir(myfile) <> "" Then
    onay = MsgBox(myfile & vbLf & "dosyası zaten var, üzerine yazılsın mı?", vbYesNo)
    If onay = vbYes Then
        ThisWorkbook.Sheets(strSheets).Select
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        myfile, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=True
        GR.Select
    Else
        Exit Sub
    End If
Else
    ThisWorkbook.Sheets(strSheets).Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    myfile, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, OpenAfterPublish:=True
    GR.Select
End If
Else
MsgBox "Sen Bilirsin", vbOKOnly, "Vazgeçtin"
End If
End Sub

 

[euphrates55]

ilk kez kayıt yapacaksam eğer yani kaydedeceğim isim ile aynı dosya yoksa, pdf kaydı yapmıyor artık. eğer zaten bir dosya varsa ve aynı isimle kayıt yapmaya çalışırsam dediğiniz gibi çalışıyor.

 

[ÖmerBey]

Haklısınız, öbür tarafa odaklanınca o kısmı kaçırmışım.
Yukarıdaki kodu güncelledim.

 

[euphrates55]

teşekkürler. eksiksiz

 

[ÖmerBey]

Rica ederim,
İyi çalışmalar...