Pdf kaydetme şarta bağlı farklı klasörlere

N

netvolxxx

Altın Üye
Katılım
29 Ağustos 2023
Mesajlar
196
Excel Vers. ve Dili
2013 Türkçe
Altın Üyelik Bitiş Tarihi
15-04-2027
Merhaba forumda araştırdım ama bi türlü istediğim gibi olmadı
excel vba userform üzerinden pdf olarak kaydet dediğim zaman belgelerim için kaydetme yapıyor
burda ki şart a2 hücresinde dolu ise kayıt yapıyor pdf adını da burdan kaydediyor

şöyle bir şey yapmak istiyorum

t2 hücresinde teklif yazıyorsa pdf dosyasını D:\mavi\ alanına kayıt yapıcak
ayırca belgelerim alınana her zaman kayıt yapcak pdf dosyasını

aynı anda belgelerim ve D:\mavi\ klasör içine kayıt etmesini nasıl kod ile yazabilirim.

D:\mavi\ tek şart t2 hücresinde teklif yazması bu alanda başka bir şey yazması durumunda d:\mavi klasör pdf olarak kayıt yapmıcak..


pdf yap alanında kullandığım kodlar şunlar

Private Sub CommandButton10_Click()
'pdf kaydetme ayar yeri
On Local Error Resume Next
If ComboBox5.Value = "" Then
MsgBox ("UYARI SİPARİŞ ŞEKLİ BOŞ LÜTFEN SEÇİM YAPIN")
Exit Sub
End If


Dim PrinterDialog As Object
Dim SelectedPrinter As String

' Yazıcı seçim kutusunu oluştur
Set PrinterDialog = Application.Dialogs(xlDialogPrinterSetup)

' Kullanıcıdan yazıcı seçimini iste
If PrinterDialog.Show = -1 Then
SelectedPrinter = PrinterDialog.DeviceName
Else
MsgBox "Yazıcı seçilmediği için işlem iptal edildi."
Exit Sub
End If

If [A2] = "" Then
MsgBox ("ADI SOYADI ALANI BOŞ KONTROL EDİN")
Exit Sub
End If
ActiveSheet.PageSetup.Orientation = xlPortrait
ActiveSheet.PageSetup.Zoom = 62
ActiveSheet.PageSetup.PaperSize = xlPaperA3
If Range("C79") = "" Then
ActiveSheet.PageSetup.PrintArea = "$A$1:$J$78"
ElseIf Range("C154") = "" Then
ActiveSheet.PageSetup.PrintArea = "$A$1:$J$77,$A$78:$J$153"
ElseIf Range("C229") = "" Then
ActiveSheet.PageSetup.PrintArea = "$A$1:$J$77,$A$78:$J$153,$A$154:$J$228"
ElseIf Range("C304") = "" Then
ActiveSheet.PageSetup.PrintArea = "$A$1:$J$77,$A$78:$J$53,$A$154:$J$228,$A$229:$J$303"
ElseIf Range("C379") = "" Then
ActiveSheet.PageSetup.PrintArea = "$A$1:$J$77,$A$78:$J$53,$A$154:$J$228,$A$229:$J$303,$A$304:$J$378"
End If

Sheets("Teklif").Select
Set shsayfa = Sheets("Teklif")
Yol = " & " \ " & [A2]"

shsayfa.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Yol & [A2] & " " & [v2], Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

end sub
 
M

muhasebeciyiz

Altın Üye
Katılım
10 Şubat 2006
Mesajlar
888
Excel Vers. ve Dili
Office 2016
64 Bit
Altın Üyelik Bitiş Tarihi
21-12-2027
Kod: 
Private Sub CommandButton10_Click()
    On Error GoTo HataYakala

    If ComboBox5.Value = "" Then
        MsgBox "UYARI: SİPARİŞ ŞEKLİ BOŞ! LÜTFEN SEÇİM YAPIN", vbExclamation
        Exit Sub
    End If

    If Range("A2").Value = "" Then
        MsgBox "ADI SOYADI ALANI BOŞ! LÜTFEN KONTROL EDİN", vbExclamation
        Exit Sub
    End If
    
    Dim PrinterDialog As Object
    Set PrinterDialog = Application.Dialogs(xlDialogPrinterSetup)
    If PrinterDialog.Show <> -1 Then
        MsgBox "Yazıcı seçilmediği için işlem iptal edildi.", vbInformation
        Exit Sub
    End If
    
    With ActiveSheet.PageSetup
        .Orientation = xlPortrait
        .Zoom = 62
        .PaperSize = xlPaperA3
    End With
    
    If Range("C79") = "" Then
        ActiveSheet.PageSetup.PrintArea = "$A$1:$J$78"
    ElseIf Range("C154") = "" Then
        ActiveSheet.PageSetup.PrintArea = "$A$1:$J$77,$A$78:$J$153"
    ElseIf Range("C229") = "" Then
        ActiveSheet.PageSetup.PrintArea = "$A$1:$J$77,$A$78:$J$153,$A$154:$J$228"
    ElseIf Range("C304") = "" Then
        ActiveSheet.PageSetup.PrintArea = "$A$1:$J$77,$A$78:$J$153,$A$154:$J$228,$A$229:$J$303"
    ElseIf Range("C379") = "" Then
        ActiveSheet.PageSetup.PrintArea = "$A$1:$J$77,$A$78:$J$153,$A$154:$J$228,$A$229:$J$303,$A$304:$J$378"
    End If
    
    Dim DosyaAdi As String
    DosyaAdi = Range("A2").Value & " " & Range("V2").Value & ".pdf"
    
    Dim BelgelerimYolu As String
    BelgelerimYolu = Environ("USERPROFILE") & "\Documents\" & DosyaAdi
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=BelgelerimYolu, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=False
    
    If LCase(Trim(Range("T2").Value)) = "teklif" Then
        Dim Dizin As String
        Dizin = "D:\mavi\"
        
        If Dir(Dizin, vbDirectory) = "" Then MkDir Dizin
        
        Dim MaviYol As String
        MaviYol = Dizin & DosyaAdi

        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=MaviYol, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
    End If

    MsgBox "PDF başarıyla kaydedildi.", vbInformation
    Exit Sub

HataYakala:
    MsgBox "Hata oluştu: " & Err.Description, vbCritical
End Sub
 
N

netvolxxx

Altın Üye
Katılım
29 Ağustos 2023
Mesajlar
196
Excel Vers. ve Dili
2013 Türkçe
Altın Üyelik Bitiş Tarihi
15-04-2027
muhasebeciyiz' Alıntı:
Kod: 
Private Sub CommandButton10_Click()
    On Error GoTo HataYakala

    If ComboBox5.Value = "" Then
        MsgBox "UYARI: SİPARİŞ ŞEKLİ BOŞ! LÜTFEN SEÇİM YAPIN", vbExclamation
        Exit Sub
    End If

    If Range("A2").Value = "" Then
        MsgBox "ADI SOYADI ALANI BOŞ! LÜTFEN KONTROL EDİN", vbExclamation
        Exit Sub
    End If
   
    Dim PrinterDialog As Object
    Set PrinterDialog = Application.Dialogs(xlDialogPrinterSetup)
    If PrinterDialog.Show <> -1 Then
        MsgBox "Yazıcı seçilmediği için işlem iptal edildi.", vbInformation
        Exit Sub
    End If
   
    With ActiveSheet.PageSetup
        .Orientation = xlPortrait
        .Zoom = 62
        .PaperSize = xlPaperA3
    End With
   
    If Range("C79") = "" Then
        ActiveSheet.PageSetup.PrintArea = "$A$1:$J$78"
    ElseIf Range("C154") = "" Then
        ActiveSheet.PageSetup.PrintArea = "$A$1:$J$77,$A$78:$J$153"
    ElseIf Range("C229") = "" Then
        ActiveSheet.PageSetup.PrintArea = "$A$1:$J$77,$A$78:$J$153,$A$154:$J$228"
    ElseIf Range("C304") = "" Then
        ActiveSheet.PageSetup.PrintArea = "$A$1:$J$77,$A$78:$J$153,$A$154:$J$228,$A$229:$J$303"
    ElseIf Range("C379") = "" Then
        ActiveSheet.PageSetup.PrintArea = "$A$1:$J$77,$A$78:$J$153,$A$154:$J$228,$A$229:$J$303,$A$304:$J$378"
    End If
   
    Dim DosyaAdi As String
    DosyaAdi = Range("A2").Value & " " & Range("V2").Value & ".pdf"
   
    Dim BelgelerimYolu As String
    BelgelerimYolu = Environ("USERPROFILE") & "\Documents\" & DosyaAdi
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=BelgelerimYolu, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=False
   
    If LCase(Trim(Range("T2").Value)) = "teklif" Then
        Dim Dizin As String
        Dizin = "D:\mavi\"
       
        If Dir(Dizin, vbDirectory) = "" Then MkDir Dizin
       
        Dim MaviYol As String
        MaviYol = Dizin & DosyaAdi

        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=MaviYol, _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
    End If

    MsgBox "PDF başarıyla kaydedildi.", vbInformation
    Exit Sub

HataYakala:
    MsgBox "Hata oluştu: " & Err.Description, vbCritical
End Sub
Genişletmek için tıkla ...
Merhaba çok teşekürrr ederim istediğim buydu üstad allah razı olsun sağolasın..
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst