Soru VERİ DOĞRULAMA- DÖNGÜ

[mustafa_123]

** B2:B6 hücrelerini D2 hücresinde veri doğrulama yaptım
** Çağrılan isimle bağlantılı veriler tabloya gelecek (bu bölümü ben ayrıyeten yapabiliyorum). (Asıl dosyayı veri gizliliğinden dolayı yükleyemiyorum, Bu dosyada yardımcı olursanız burada ki kodları asıl dosyaya uyarlayabilirim .)

** Yardımınızı istediğim konu veri doğrulama yaptığım D2 hücresini bir kod ile sırayla çağırmak, yani döngü oluşturmak ve B11:G21 arasındaki tabloyu PDF olarak kaydetmek veya yazdırmak. ( bu olayın veri doğrulamadaki (D2 hücresindeki ) isimler bitene kadar tekrar etmesini sağlayacak kod lazım.)

**Yardımlarınızı bekliyorum. Şimdiden teşekkürler. Emeğinize sağlık.

DOSYA LİNKİ:
https://drive.google.com/file/d/1SI59Udpu6SHz2NeayVzcgh53M8B_hT_0/view

 

[Ömer]

Merhaba,

Dosyanızı açamadım.

Sub deneme()

    Dim deg As Range, yol As String
    
    yol = ThisWorkbook.Path
    
    ActiveSheet.PageSetup.PrintArea = "B11:G21"
    
    ChDir ThisWorkbook.Path
    For Each deg In Range("B2:B6")
        If deg <> "" Then
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                yol & "\" & deg & ".pdf", Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, IgnorePrintAreas:=False
        End If
    Next
    
End Sub

 

[mustafa_123]

Cevabınız için teşekkür ederim. birde bu linkten denerseniz sevinirim . istediğim D2 hücresindeki veri doğrulamanın döngüye girip tablonun öyle yazdırılması

https://drive.google.com/file/d/1SI59Udpu6SHz2NeayVzcgh53M8B_hT_0/view?usp=sharing

 

[Ömer]

Deneyiniz.

Sub deneme()

    Dim deg As Range, yol As String
   
    yol = ThisWorkbook.Path
   
    Application.ScreenUpdating = False
    ActiveSheet.PageSetup.PrintArea = "B11:G21"
   
    ChDir yol
    For Each deg In Range("B2:B6")
        If deg <> "" Then
            [D2] = deg
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                yol & "\" & deg & ".pdf", Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, IgnorePrintAreas:=False
        End If
    Next
   
End Sub

 

[mustafa_123]

Deneyiniz.

Sub deneme()

    Dim deg As Range, yol As String
  
    yol = ThisWorkbook.Path
  
    Application.ScreenUpdating = False
    ActiveSheet.PageSetup.PrintArea = "B11:G21"
  
    ChDir yol
    For Each deg In Range("B2:B6")
        If deg <> "" Then
            [D2] = deg
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                yol & "\" & deg & ".pdf", Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, IgnorePrintAreas:=False
        End If
    Next
  
End Sub

Teşekkürler, kod işime yaradı. Emeğinize sağlık