Excelde Dışarı aktarma makrosu ya da kodu

O

oglcn

Altın Üye
Katılım
11 Haziran 2021
Mesajlar
28
Excel Vers. ve Dili
2016 tr
Altın Üyelik Bitiş Tarihi
11-12-2025
Arkadaşlar Merhaba,

Şimdi Şöyle bir sorunum var: Bir çalışma kitabının içinde SİPARİŞ LİSTESİ sayfasında, B sütununda ürün listesi var. buradaki her bir ürünün numarasını. 2. sayfa içerisindeki A11 sütununa giriyorum ve o ürüne ait SİPARİŞ LİSTESİ sayfasındaki detaylar. 1, 2 ve 3. sayfadaki formu dolduruyor. Öyle bir makro veya VBA kodu olmalı ki. ben komutu başlattığımda listedeki her ürün için 2,3 ve4. sayfadaki formu doldurup dışarıya pdf olarak kaydetsin. Bunu yaparken de dosya adının sonuna ürün numarasını eklesin

Örneğin:
ürün1 in kodu: 0010 butona basınca, 2.sayfadaki A11 sütununa veriyi girecek. ve 2, 3 ve 4. sayfaları pdf olarak masaüstüne kaydedecek.
dosya isimleri de "ÖRNEK-SAYFA2-0010" "ÖRNEK-SAYFA3-0010" "ÖRNEK-SAYFA4-0010" şeklinde olacak.

ve bunu döngüyü tüm ürünler için döndürecek bir formüle ihtiyacım var. excel dosyası aşağıdaki linktedir.

Şimdiden teşekkürler

örnek.xlsx - 28 KB
 
O

oglcn

Altın Üye
Katılım
11 Haziran 2021
Mesajlar
28
Excel Vers. ve Dili
2016 tr
Altın Üyelik Bitiş Tarihi
11-12-2025
ben biraz internetten bakarak yaptım ama tam olarak istediğime cevap vermiyor. bu kodu sütundaki tüm satırlar için döndürmem lazım


Sub PDFKayıtetme()
Dim klasor As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Lütfen Kayıt Klasörünü Seçiniz"
If .Show = -1 Then klasor = .SelectedItems(1)
End With
If klasor = "" Then Exit Sub
Dim sh As Worksheet
For Each sh In ActiveWorkbook.Worksheets
sh.ExportAsFixedFormat xlTypePDF, klasor & Application.PathSeparator & sh.Name & ".pdf"
Next
MsgBox "PDF Kayıt İşlemi Tamamlandı"
End Sub
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,728
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Deneyiniz.

Masa üstünde "Sipariş Formları" adında bir klasör oluşur. Klasör içine sipariş formları PDF formatında kayıt edilir.

C++: 
Option Explicit

Sub Siparis_Formlarini_Pdf_Formatinda_Olustur()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim S3 As Worksheet, S4 As Worksheet
    Dim Son As Long, X As Long, Klasor As String
    
    Set S1 = Sheets("SİPARİŞ LİSTESİ")
    Set S2 = Sheets("Manufacturer Declaration")
    Set S3 = Sheets("Cert. of origin")
    Set S4 = Sheets("Doc.List")
    
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    
    If Son = 1 Then
        MsgBox "Formu oluşturulacak sipariş bulunamadı!", vbExclamation
        GoTo 10
    End If
    
    Klasor = CreateObject("Wscript.Shell").SpecialFolders("Desktop") & "\Sipariş Formları\"
    
    If Dir(Klasor, vbDirectory) = "" Then MkDir Klasor
    
    
    For X = 2 To Son
        If S1.Cells(X, 1) <> "" Then
            S2.Range("A11") = S1.Cells(X, 1)
            
            S2.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=Klasor & "ÖRNEK-SAYFA2-" & S1.Cells(X, 1) & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
        
            S3.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=Klasor & "ÖRNEK-SAYFA3-" & S1.Cells(X, 1) & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
        
            S4.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=Klasor & "ÖRNEK-SAYFA4-" & S1.Cells(X, 1) & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
        End If
    Next
    
    MsgBox "Sipariş formları oluşturulmuştur.", vbInformation

10  Set S1 = Nothing
    Set S2 = Nothing
    Set S3 = Nothing
    Set S4 = Nothing
End Sub
 
O

oglcn

Altın Üye
Katılım
11 Haziran 2021
Mesajlar
28
Excel Vers. ve Dili
2016 tr
Altın Üyelik Bitiş Tarihi
11-12-2025
Korhan Ayhan' Alıntı:
Deneyiniz.

Masa üstünde "Sipariş Formları" adında bir klasör oluşur. Klasör içine sipariş formları PDF formatında kayıt edilir.

C++: 
Option Explicit

Sub Siparis_Formlarini_Pdf_Formatinda_Olustur()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim S3 As Worksheet, S4 As Worksheet
    Dim Son As Long, X As Long, Klasor As String
  
    Set S1 = Sheets("SİPARİŞ LİSTESİ")
    Set S2 = Sheets("Manufacturer Declaration")
    Set S3 = Sheets("Cert. of origin")
    Set S4 = Sheets("Doc.List")
  
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
  
    If Son = 1 Then
        MsgBox "Formu oluşturulacak sipariş bulunamadı!", vbExclamation
        GoTo 10
    End If
  
    Klasor = CreateObject("Wscript.Shell").SpecialFolders("Desktop") & "\Sipariş Formları\"
  
    If Dir(Klasor) = "" Then MkDir Klasor
  
  
    For X = 2 To Son
        If S1.Cells(X, 1) <> "" Then
            S2.Range("A11") = S1.Cells(X, 1)
          
            S2.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=Klasor & "ÖRNEK-SAYFA2-" & S1.Cells(X, 1) & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
      
            S3.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=Klasor & "ÖRNEK-SAYFA3-" & S1.Cells(X, 1) & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
      
            S4.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=Klasor & "ÖRNEK-SAYFA4-" & S1.Cells(X, 1) & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
        End If
    Next
  
    MsgBox "Sipariş formları oluşturulmuştur.", vbInformation

10  Set S1 = Nothing
    Set S2 = Nothing
    Set S3 = Nothing
    Set S4 = Nothing
End Sub
Genişletmek için tıkla ...

süpersiniz elinize sağlık. tekte çözdünüz sorunumu. çok teşekkürler
 
O

oglcn

Altın Üye
Katılım
11 Haziran 2021
Mesajlar
28
Excel Vers. ve Dili
2016 tr
Altın Üyelik Bitiş Tarihi
11-12-2025
Korhan Ayhan' Alıntı:
Deneyiniz.

Masa üstünde "Sipariş Formları" adında bir klasör oluşur. Klasör içine sipariş formları PDF formatında kayıt edilir.

C++: 
Option Explicit

Sub Siparis_Formlarini_Pdf_Formatinda_Olustur()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim S3 As Worksheet, S4 As Worksheet
    Dim Son As Long, X As Long, Klasor As String
   
    Set S1 = Sheets("SİPARİŞ LİSTESİ")
    Set S2 = Sheets("Manufacturer Declaration")
    Set S3 = Sheets("Cert. of origin")
    Set S4 = Sheets("Doc.List")
   
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
   
    If Son = 1 Then
        MsgBox "Formu oluturulacak sipariş bulunamadı!", vbExclamation
        GoTo 10
    End If
   
    Klasor = CreateObject("Wscript.Shell").SpecialFolders("Desktop") & "\Sipariş Formları\"
   
    If Dir(Klasor) = "" Then MkDir Klasor
   
   
    For X = 2 To Son
        If S1.Cells(X, 1) <> "" Then
            S2.Range("A11") = S1.Cells(X, 1)
           
            S2.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=Klasor & "ÖRNEK-SAYFA2-" & S1.Cells(X, 1) & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
       
            S3.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=Klasor & "ÖRNEK-SAYFA3-" & S1.Cells(X, 1) & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
       
            S4.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=Klasor & "ÖRNEK-SAYFA4-" & S1.Cells(X, 1) & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
        End If
    Next
   
    MsgBox "Sipariş formları oluşturulmuştur.", vbInformation

10  Set S1 = Nothing
    Set S2 = Nothing
    Set S3 = Nothing
    Set S4 = Nothing
End Sub
Genişletmek için tıkla ...

burada sistemin dışarı çıktı alırken yazdırılabilir alanı referans alıyor değil mi ? yani biçimimi ona göre ayarlamalıyım ?
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,728
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Sayfayı export ediyor. Sayfada ne varsa hepsini alması gerekir.
 
O

oglcn

Altın Üye
Katılım
11 Haziran 2021
Mesajlar
28
Excel Vers. ve Dili
2016 tr
Altın Üyelik Bitiş Tarihi
11-12-2025
Korhan Ayhan' Alıntı:
Sayfayı export ediyor. Sayfada ne varsa hepsini alması gerekir.
Genişletmek için tıkla ...
Kodu il çalıştırdığımda klasörü açıp dosyaları kaydediyor. Fakat 2. kez çalıştırdığımda kodun bu kısmı hata veriyor ve hatayı gidermek için bi önceki oluşturduğu Siparis Listesi klsörünü silmem gerekiyor
Then MkDir Klasor

bunun yerine benim yazdığım koddaki gibi her seferinde klasör sorması için ilgili kodu nereye yazmam gerekir ?

C++: 
Dim klasor As String
With Application.FileDialog(msoFileDialogFolderPicker)
            .Title = "Lütfen Kayıt Klasörünü Seçiniz"
            If .Show = -1 Then klasor = .SelectedItems(1)
        End With
 
Son düzenleme:
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,728
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Ben şimdi tekrar denedim. Klasör doluysa herhangi bir hata vermiyor. Klasör boşsa hata veriyor.

Yine de #3 nolu mesajımda ki kodu revize ettim. Tekrar deneyiniz.
 
O

oglcn

Altın Üye
Katılım
11 Haziran 2021
Mesajlar
28
Excel Vers. ve Dili
2016 tr
Altın Üyelik Bitiş Tarihi
11-12-2025
Korhan Ayhan' Alıntı:
Ben şimdi tekrar denedim. Klasör doluysa herhangi bir hata vermiyor. Klasör boşsa hata veriyor.

Yine de #3 nolu mesajımda ki kodu revize ettim. Tekrar deneyiniz.
Genişletmek için tıkla ...
Teşekkürler. Bir de şunu eklmek istiyorum onu nasıl yapabiliriz acaba

Mesela 0010 numaralı ürün için 1.sayfada ek bitane sütun açtım diyelim. İsmi de "Basınç Testi" olsun.
aynı zamanda "Basınç Test Raporu" için de için de yeni bir sayfa açtım. Ve bir tane test raporu oluşturdum diyelim. Dolayısı ile ben 2.sayfadan ürün kodlarını çağırırken "Basınç Test Raporu" sadece 0010 numaralı ürün için dolacak ve sizin yazdığınız kod ile dışarı aktarırken "Basınç Test Raporu" sadece 0010 numaralı ürün için dışarı pdf olarak kaydedilecek.

Ve ben bunun hangi üründe olduğunu işaretleyerek kodu çalıştıracağım. mesela sadece 0010 , 0060, 0070 numaralı ürünler için basınç testi girmiş isem, dışarı aktarırken test raporunu sadece bu ürünler için kaydedecek
 
O

oglcn

Altın Üye
Katılım
11 Haziran 2021
Mesajlar
28
Excel Vers. ve Dili
2016 tr
Altın Üyelik Bitiş Tarihi
11-12-2025
Korhan Ayhan' Alıntı:
Ben şimdi tekrar denedim. Klasör doluysa herhangi bir hata vermiyor. Klasör boşsa hata veriyor.

Yine de #3 nolu mesajımda ki kodu revize ettim. Tekrar deneyiniz.
Genişletmek için tıkla ...

Hocam bir de bu kod sadece 28.satıra kadar çalışıyo. ben veri eklemeye devam ettikçe kod o ürün numaraları için de çalışmalı.

edit: tamamdır oluyormuş şimdi farkettim
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,728
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Örnek dosya üzerinde tarif ederseniz daha sağlıklı yanıt verebilirim.
 
O

oglcn

Altın Üye
Katılım
11 Haziran 2021
Mesajlar
28
Excel Vers. ve Dili
2016 tr
Altın Üyelik Bitiş Tarihi
11-12-2025
Korhan Ayhan' Alıntı:
Örnek dosya üzerinde tarif ederseniz daha sağlıklı yanıt verebilirim.
Genişletmek için tıkla ...

şu şekilde yani:



görseldeki gibi bazı ürünlerin testleri olacak 1 den fazla da olabilir. aynı şekilde test1, test2, test3 sayfaları açaçacağım. Bu sayfaları sadece işaretli ürünler için dışarı aktaracak. Örneğin görseldeki 0070 kodlu üründen kaydettiği 3 pdf haricinde test1 ve tets3 sayfalarını da aktaracak dışarı
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,728
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Deneyiniz.

Dosya isimlerini kendiniz istediğiniz gibi düzenlersiniz.

C++: 
Option Explicit

Sub Siparis_Formlarini_Pdf_Formatinda_Olustur()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim S3 As Worksheet, S4 As Worksheet
    Dim S5 As Worksheet, S6 As Worksheet, S7 As Worksheet
    Dim Son As Long, X As Long, Klasor As String
    
    Set S1 = Sheets("SİPARİŞ LİSTESİ")
    Set S2 = Sheets("Manufacturer Declaration")
    Set S3 = Sheets("Cert. of origin")
    Set S4 = Sheets("Doc.List")
    Set S5 = Sheets("test1")
    Set S6 = Sheets("test2")
    Set S7 = Sheets("test3")
    
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    
    If Son = 1 Then
        MsgBox "Formu oluşturulacak sipariş bulunamadı!", vbExclamation
        GoTo 10
    End If
    
    Klasor = CreateObject("Wscript.Shell").SpecialFolders("Desktop") & "\Sipariş Formları\"
    
    If Dir(Klasor, vbDirectory) = "" Then MkDir Klasor
    
    
    For X = 2 To Son
        If S1.Cells(X, 1) <> "" Then
            S2.Range("A11") = S1.Cells(X, 1)
            
            S2.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=Klasor & "ÖRNEK-SAYFA2-" & S1.Cells(X, 1) & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
        
            S3.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=Klasor & "ÖRNEK-SAYFA3-" & S1.Cells(X, 1) & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
        
            S4.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=Klasor & "ÖRNEK-SAYFA4-" & S1.Cells(X, 1) & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
        
            If UCase(S1.Cells(X, "G")) = "X" Then
                S5.ExportAsFixedFormat Type:=xlTypePDF, _
                Filename:=Klasor & "test1-" & S1.Cells(X, 1) & ".pdf", _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, OpenAfterPublish:=False
            End If
            
            If UCase(S1.Cells(X, "H")) = "X" Then
                S6.ExportAsFixedFormat Type:=xlTypePDF, _
                Filename:=Klasor & "test2-" & S1.Cells(X, 1) & ".pdf", _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, OpenAfterPublish:=False
            End If
        
            If UCase(S1.Cells(X, "I")) = "X" Then
                S7.ExportAsFixedFormat Type:=xlTypePDF, _
                Filename:=Klasor & "test3-" & S1.Cells(X, 1) & ".pdf", _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, OpenAfterPublish:=False
            End If
        End If
    Next
    
    MsgBox "Sipariş formları oluşturulmuştur.", vbInformation

10  Set S1 = Nothing
    Set S2 = Nothing
    Set S3 = Nothing
    Set S4 = Nothing
End Sub
 
O

oglcn

Altın Üye
Katılım
11 Haziran 2021
Mesajlar
28
Excel Vers. ve Dili
2016 tr
Altın Üyelik Bitiş Tarihi
11-12-2025
Korhan Ayhan' Alıntı:
Deneyiniz.

Dosya isimlerini kendiniz istediğiniz gibi düzenlersiniz.

C++: 
Option Explicit

Sub Siparis_Formlarini_Pdf_Formatinda_Olustur()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim S3 As Worksheet, S4 As Worksheet
    Dim S5 As Worksheet, S6 As Worksheet, S7 As Worksheet
    Dim Son As Long, X As Long, Klasor As String
   
    Set S1 = Sheets("SİPARİŞ LİSTESİ")
    Set S2 = Sheets("Manufacturer Declaration")
    Set S3 = Sheets("Cert. of origin")
    Set S4 = Sheets("Doc.List")
    Set S5 = Sheets("test1")
    Set S6 = Sheets("test2")
    Set S7 = Sheets("test3")
   
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
   
    If Son = 1 Then
        MsgBox "Formu oluşturulacak sipariş bulunamadı!", vbExclamation
        GoTo 10
    End If
   
    Klasor = CreateObject("Wscript.Shell").SpecialFolders("Desktop") & "\Sipariş Formları\"
   
    If Dir(Klasor, vbDirectory) = "" Then MkDir Klasor
   
   
    For X = 2 To Son
        If S1.Cells(X, 1) <> "" Then
            S2.Range("A11") = S1.Cells(X, 1)
           
            S2.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=Klasor & "ÖRNEK-SAYFA2-" & S1.Cells(X, 1) & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
       
            S3.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=Klasor & "ÖRNEK-SAYFA3-" & S1.Cells(X, 1) & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
       
            S4.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=Klasor & "ÖRNEK-SAYFA4-" & S1.Cells(X, 1) & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
       
            If UCase(S1.Cells(X, "G")) = "X" Then
                S5.ExportAsFixedFormat Type:=xlTypePDF, _
                Filename:=Klasor & "test1-" & S1.Cells(X, 1) & ".pdf", _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, OpenAfterPublish:=False
            End If
           
            If UCase(S1.Cells(X, "H")) = "X" Then
                S6.ExportAsFixedFormat Type:=xlTypePDF, _
                Filename:=Klasor & "test2-" & S1.Cells(X, 1) & ".pdf", _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, OpenAfterPublish:=False
            End If
       
            If UCase(S1.Cells(X, "I")) = "X" Then
                S7.ExportAsFixedFormat Type:=xlTypePDF, _
                Filename:=Klasor & "test3-" & S1.Cells(X, 1) & ".pdf", _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, OpenAfterPublish:=False
            End If
        End If
    Next
   
    MsgBox "Sipariş formları oluşturulmuştur.", vbInformation

10  Set S1 = Nothing
    Set S2 = Nothing
    Set S3 = Nothing
    Set S4 = Nothing
End Sub
Genişletmek için tıkla ...
Hocam resimdeki gibi bir hata veriyor. Dosyayı da ekliyorum aşağıya




örnek.xlsm - 42 KB
 
I

ismailem

https://asrisaadetyolu.blogspot.com/
Katılım
5 Haziran 2012
Mesajlar
102
Excel Vers. ve Dili
Office 2016 TR 64 Bit
Altın Üyelik Bitiş Tarihi
19-10-2023
Cevap yazmak için giriş yap yada kayıt ol.
Üst