• DİKKAT

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

Data Validation ile oluşturulan Dropdown Hak.

. . .

Müsait olduğunuzda TeamViewer ile bağlanıp kontrol edebilir miyim.

. . .
 
Veri doğrulamada kullandığınız formül nedir?
 
B3 hücresindeki veri doğrulama listesindeki formülünüz nedir?

"X_KODList" bu tanımlama hangi adresi ifade ediyor.

Aşağıdaki kodu bir deneyiniz.

Kod: 
Sub KOD_PDF()
    Dim Sh As Worksheet, Yol As String, Adres As String, Veri As Range, Sayfa As Worksheet
    
    Set Sh = Worksheets("Sheet2")
    
    Yol = CreateObject("WScript.Shell").specialfolders("Desktop") & "\"
    
    Adres = Replace(Sh.Range("B3").Validation.Formula1, "=", "")
    Set Sayfa = Worksheets(Split(Adres, "!")(0))
    
    For Each Veri In Sayfa.Range(Adres)
        Sh.Range("B3").Value = Veri.Value
        Sh.Range("A1:C7").ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=Yol & Sh.Range("D3").Value & " - " & Sh.Range("B5").Value & " - " & Sh.Range("B6").Value & " - " & " Deneme_2016" & ".pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    Next

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Korhan Ayhan' Alıntı:
B3 hücresindeki veri doğrulama listesindeki formülünüz nedir?

"X_KODList" bu tanımlama hangi adresi ifade ediyor.

Aşağıdaki kodu bir deneyiniz.

Kod: 
Sub KOD_PDF()
    Dim Sh As Worksheet, Yol As String, Adres As String, Veri As Range, Sayfa As Worksheet
    
    Set Sh = Worksheets("Sheet2")
    
    Yol = CreateObject("WScript.Shell").specialfolders("Desktop") & "\"
    
    Adres = Replace(Sh.Range("B3").Validation.Formula1, "=", "")
    Set Sayfa = Worksheets(Split(Adres, "!")(0))
    
    For Each Veri In Sayfa.Range(Adres)
        Sh.Range("B3").Value = Veri.Value
        Sh.Range("A1:C7").ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=Yol & Sh.Range("D3").Value & " - " & Sh.Range("B5").Value & " - " & Sh.Range("B6").Value & " - " & " Deneme_2016" & ".pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    Next

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
Genişletmek için tıkla ...

Kod gönderdiğim Örnek'te çalışıyor ama kendi dosyamda çalışmıyor kafayı sıyıracağım :) Kodlama bilen bir insan olarak sadece değişkenleri değiştiriyorum. X_KODList gibi adlandırmaları da sildim direk hücre adı (F15 gibi) ile çalışıyorum. Subscript error veriyor.

Macrolu dosyayı desktop'a aldım, belki bir alakası vardır diye o da bana mısın demedi.

En son gönderdiğiniz kodda aynı şekilde sıkıntı yarattı. İnanın, size gönderdiğim örnek dosya ile hiç bir farkı yok asıl dosyamın.

Edit: Data Validation'daki Dropdownda 98 tane değer var. Bundan kaynaklanıyor olabilir mi?

Edit-2: Örnek dosyaya 98 veri girdim, gayet güzel çalıştı.

Edit-3: F15 (Veri Doğrulamanın yarattığı DropDown Menünün olduğu hücre) formül şudur: ='Mail Adresleri'!$A$2:$A$99
 
Son düzenleme:
Aşağıdaki kodu deneyiniz.

Kod: 
Sub KOD_PDF()
    Dim Sh As Worksheet, Yol As String, Adres As String, Veri As Range, Sayfa As Worksheet
    
    Application.ScreenUpdating = False
    
    Set Sh = Worksheets("Sheet2")
    
    Yol = CreateObject("WScript.Shell").specialfolders("Desktop") & "\"
    
    Adres = Replace(Replace(Sh.Range("B3").Validation.Formula1, "=", ""), "'", "")
    Set Sayfa = Worksheets(Split(Adres, "!")(0))
    Adres = Split(Adres, "!")(1)
    
    For Each Veri In Sayfa.Range(Adres)
        Sh.Range("B3").Value = Veri.Value
        Sh.Range("A1:C7").ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=Yol & Sh.Range("D3").Value & " - " & Sh.Range("B5").Value & " - " & Sh.Range("B6").Value & " - " & " Deneme_2016" & ".pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    Next

    Application.ScreenUpdating = True

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 
Korhan Ayhan' Alıntı:
Aşağıdaki kodu deneyiniz.

Kod: 
Sub KOD_PDF()
    Dim Sh As Worksheet, Yol As String, Adres As String, Veri As Range, Sayfa As Worksheet
    
    Application.ScreenUpdating = False
    
    Set Sh = Worksheets("Sheet2")
    
    Yol = CreateObject("WScript.Shell").specialfolders("Desktop") & "\"
    
    Adres = Replace(Replace(Sh.Range("B3").Validation.Formula1, "=", ""), "'", "")
    Set Sayfa = Worksheets(Split(Adres, "!")(0))
    Adres = Split(Adres, "!")(1)
    
    For Each Veri In Sayfa.Range(Adres)
        Sh.Range("B3").Value = Veri.Value
        Sh.Range("A1:C7").ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=Yol & Sh.Range("D3").Value & " - " & Sh.Range("B5").Value & " - " & Sh.Range("B6").Value & " - " & " Deneme_2016" & ".pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    Next

    Application.ScreenUpdating = True

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
Genişletmek için tıkla ...

Ellerinize sağlık. 10 numara 5 yıldız çalıştı program. Teşekkür ederim.:)

Edit: Korhan Bey, bir şey sormak istiyorum. Sh.Range("D3").Value yerine [D3] neden kullanamıyoruz bu yazdığınız kodda?
 
Son düzenleme:
Bir şey daha sorabilir miyim? (Umarım burada yazılanlar birilerine yardımcı oluyordur :) )

108 tane PDF'i oluşturma esnasında programı nasıl abort edebilirim ?
 
[D3] olarak kullanabilmeniz için Sheet2 isimli sayfanın seçili olması (aktif) gerekir. Ayrıca bazen versiyon farklarından dolayı excel bazı durumlarda ( Sh.Range("D3").Value ) sondaki kırmızı eklentiyi istemektedir.

Son mesajınızdaki isteğinizi tam olarak anlayamadım.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst