kod içerisinde yazdırma komutlarına pdf ekletmek

E

euphrates55

Katılım
25 Ocak 2006
Mesajlar
763
Excel Vers. ve Dili
2019 tr
Altın Üyelik Bitiş Tarihi
04-01-2024
Kod: 
Sub raporyaz()

    xy = InputBox("KAÇ KOPYA OLACAK")
        If xy = "" Then
    MsgBox "başlangıç hücresini yazmadınız.", vbInformation, "        Uyarı"
    Exit Sub
    End If
 sh = InputBox("son satır sayısı (harfsiz)")
    If sh = "" Then
MsgBox "son satır numarasını yazmadınız.", vbInformation, "        Uyarı"
Exit Sub
End If

    Sheets("İCMAL").Select
    ActiveSheet.PageSetup.PrintArea = "$B$2:$BD$34"
    With ActiveSheet.PageSetup
    .PrintQuality = 600
    .Orientation = xlLandscape
    .PaperSize = xlPaperA3
    .FitToPagesWide = 1
    ActiveSheet.PrintOut Copies:=xy
    Sheets("GT").Select
    'icmal sayfası seç, b2:bd34 arasını yazdırma alanı seç ve yazdır.

    Sheets("GT").Select
    Cells.Select


    Selection.EntireColumn.Hidden = False
    Selection.EntireRow.Hidden = False
    If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData
    'gt sekmesine geç, filtre temizle ve satır sütunlarda gizlenenleri aç
    

    
    
    x = Range("$A$2").Row
    y = Range("$FI$" & sh).Column
    
    w = Range("$G$2").Row
    q = Range("$CI$" & sh).Column

    Sheets("gt").Select
Range("A2").AutoFilter 1, "T"
Range("a2").AutoFilter 5, "<>İhale Edilmesi Planlanıyor"

    'gt sekmesinde boş olanları gösterme şeklinde filtrele (burada T yi göster oluyor)

    Range("A:F,M:Q,U:U,W:W,Y:Z,AB:AB,AE:AF,AH:AI,AU:CH,CJ:KL").Select
    Selection.EntireColumn.Hidden = True
    'SÜTUNLARI SEÇ VE GİZLE
    

    
    ActiveSheet.PageSetup.PrintArea = "$G$2:$CI$" & sh
    With ActiveSheet.PageSetup
    .PrintQuality = 600
    .Orientation = xlLandscape
    .PaperSize = xlPaperA3
    .FitToPagesWide = 1
    ActiveSheet.PrintOut Copies:=xy
 End With
 
 

    Cells.Select
    Selection.EntireColumn.Hidden = False


    Range("A:F,I:ax,CJ:KP").Select
    Selection.EntireColumn.Hidden = True
    'SÜTUNLARI SEÇ VE GİZLE
    
  End With
    ActiveSheet.PageSetup.PrintArea = "$G$2:$CI$" & sh
    With ActiveSheet.PageSetup
    .PrintQuality = 600
    .Orientation = xlLandscape
    .PaperSize = xlPaperA3
    .FitToPagesWide = 1
    ActiveSheet.PrintOut Copies:=xy
    
    
 End With
    Cells.Select
    Selection.EntireColumn.Hidden = False
    Selection.EntireRow.Hidden = False
    If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData
    Range("G3").Select
    MsgBox "Rapor Yazıldı. Yazıcıya Gidebilirsin...", vbInformation
End Sub
günaydınlar.... bakınca anlayacağınız gibi, kod içerisinde belli başlı, gizleme saklama filtreleme yaparak 3 adet farklı tablo oluşturup yazdırma işlemi yaptırıyorum. yazıcıya gönderiyor. kodda sıkıntı yok. istediğim olay ise (olabiliyorsa) bu 3 farklı tablo olarak yapılan yazdırma işlemini yaptığı gibi aynı zamanda 1 pdf içinde toplatarak, bu excel dosyasının bulunduğu yere ekletmek istiyorum.
 
E

euphrates55

Katılım
25 Ocak 2006
Mesajlar
763
Excel Vers. ve Dili
2019 tr
Altın Üyelik Bitiş Tarihi
04-01-2024
pdf leri hallettim. istediğim klasör içinde 3 adet pdf dosyası oluşuyor. sıra geldi birleştirmeye. işte buna çok baktım sağdan soldan ama istediğimi bulamadım. tek sorunum ayrı bir modülde pdf birleştirme işi. buradan yukarıdaki koda bu modülü çağırttırarak da yapabilirim.

"Z:\2019\RAPORLAR\harcama\gösterim\OTORAPOR\" klasöründe a,b,c adında 3 adet pdf dosyam oluyor. bu 3 pdf dosyasının birleştirilerek rapor_bugünün tarihi_saati şeklinde bir birleşik pdf yaratması.

pdf işini aşağıdaki kodu ekleyerek hallettim.
Kod: 
    With ActiveSheet
.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:="Z:\2019\RAPORLAR\harcama\gösterim\OTORAPOR\" & "İhaleler" & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
pdf birleştiremiyorsak eğer, bu koda nasıl bir ekleme yaparsam bu dosyaları excel olarak kaydedebilirim ve sonra a bunları pdf olarak birleştirebilirim sorusu da sorulabilir.
 
Son düzenleme:
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,243
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Bence bu birleştirme işlemini ilk PDF yazdırma anında yapmanız daha uygun ve pratik olacaktır.
 
H

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
∞
Sadece MS Office Excel programını kullanarak, bilgisayarınızdaki mevcut PDF dosyalarını birleştiremez, bölemezsiniz.

PDF dosyalarını Excel ile üretiyorsanız, birleştirmek için; ya Korhan Beyin dediği gibi dosyaları oluşturma aşamasında yapacaksınız ya da bu iş için harici programlar kullanacaksınız.

.
 
E

euphrates55

Katılım
25 Ocak 2006
Mesajlar
763
Excel Vers. ve Dili
2019 tr
Altın Üyelik Bitiş Tarihi
04-01-2024
Haluk' Alıntı:
Sadece MS Office Excel programını kullanarak, bilgisayarınızdaki mevcut PDF dosyalarını birleştiremez, bölemezsiniz.

PDF dosyalarını Excel ile üretiyorsanız, birleştirmek için; ya Korhan Beyin dediği gibi dosyaları oluşturma aşamasında yapacaksınız ya da bu iş için harici programlar kullanacaksınız.

.
Genişletmek için tıkla ...
peki pdf yazdırmak yerine çıktıyı yazıcıya gönderdikten sonra bunu ayrı bir excel çalışma sayfası olarak kaydedebilir miyim. 3 excel olacak ve bunları pdf olarak toplu kaydedeceğim


Tapatalk kullanarak iPhone aracılığıyla gönderildi
 
E

euphrates55

Katılım
25 Ocak 2006
Mesajlar
763
Excel Vers. ve Dili
2019 tr
Altın Üyelik Bitiş Tarihi
04-01-2024
Kod: 
ActiveSheet.Copy
ActiveWorkbook.SaveAs "Z:\2019\RAPORLAR\harcama\gösterim\OTORAPOR\" & "İcmal.xlsx"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ActiveWorkbook.Close
bu şekilde halledebileceğimi düşünüyorum, denedim fakat bu seferde linklerden dolayı tüm tablo başvuru hatası veriyor. özel yapıştır yaptığımda da gizli hücreler olduğundan sanırım yapıştırmıyor. nasıl bir kod eklersem linkleri yani bağlantıları kaldırarak yeni sayfa olarak çoğaltabilirim.
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,243
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Örnek dosyanızı paylaşıp ne yapmak istediğinizi açıklarsanız size daha iyi yardımcı olabiliriz.
 
E

euphrates55

Katılım
25 Ocak 2006
Mesajlar
763
Excel Vers. ve Dili
2019 tr
Altın Üyelik Bitiş Tarihi
04-01-2024
tekrar merhaba. tüm işlemlerimi hallettim. son bir sorum kaldı. aşağıda vereceğim kod içerisinde klasör yaratma kısmında eğer oluşturulacak klasör mevcut durumda var ise hata alıyorum. buraya ekleyeceğimiz bir komut ile bu durumla karşılaştığında "aynı isimle klasör var, klasör oluşturulamadı..." şeklinde mesaj çıkmasını ve işlemi sonlandırmasını istiyorum. eğer ki klasör oluşturmasında sakınca yoksa diğer işlemler devam etsin.
Kod: 
Sub raporyaz()
Dim ds
Set ds = CreateObject("Scripting.FileSystemObject")
DateString1 = Format(Now, "dd-mm-yyyy")
ds.CreateFolder "Z:\A\B\C\D\" & DateString1

    xy = InputBox("KAÇ KOPYA OLACAK")
        If xy = "" Then
    MsgBox "başlangıç hücresini yazmadınız.", vbInformation, "        Uyarı"
    Exit Sub
    End If
 sh = InputBox("son satır sayısı (harfsiz)")
    If sh = "" Then
MsgBox "son satır numarasını yazmadınız.", vbInformation, "        Uyarı"
Exit Sub




End If
    Sheets("İc").Select
    ActiveSheet.PageSetup.PrintArea = "$B$2:$BD$34"
    With ActiveSheet.PageSetup
    .PrintQuality = 600
    .Orientation = xlLandscape
    .PaperSize = xlPaperA3
    .FitToPagesWide = 1
    Application.PrintCommunication = False
    ActiveSheet.PrintOut Copies:=xy
 
With ActiveSheet
DateString = Format(Now, "dd-mm-yyyy hh-mm-ss")

.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:="Z:\A\B\C\D\" & DateString1 & "\" & "İc_" & DateString & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False

End With
    Sheets("GT").Select
    'icmal sayfası seç, b2:bd34 arasını yazdırma alanı seç ve yazdır.

    Sheets("GT").Select
    Cells.Select

    Selection.EntireColumn.Hidden = False
    Selection.EntireRow.Hidden = False
    If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData
    'gt sekmesine geç, filtre temizle ve satır sütunlarda gizlenenleri aç
    
    x = Range("$A$2").Row
    y = Range("$FI$" & sh).Column
    
    w = Range("$G$2").Row
    q = Range("$CI$" & sh).Column

    Sheets("gt").Select
Range("A2").AutoFilter 1, "T"
Range("a2").AutoFilter 5, "<>İhale Edilmesi Planlanıyor"

    'gt sekmesinde boş olanları gösterme şeklinde filtrele (burada T yi göster oluyor)

    Range("A:F,M:Q,U:U,W:W,Y:Z,AB:AB,AE:AF,AH:AI,AU:CH,CJ:KL").Select
    Selection.EntireColumn.Hidden = True
    'SÜTUNLARI SEÇ VE GİZLE
    
    ActiveSheet.PageSetup.PrintArea = "$G$2:$CI$" & sh
    With ActiveSheet.PageSetup
    .PrintQuality = 600
    .Orientation = xlLandscape
    .PaperSize = xlPaperA3
    .FitToPagesWide = 1
       Application.PrintCommunication = False
    ActiveSheet.PrintOut Copies:=xy
    
    With ActiveSheet
DateString = Format(Now, "dd-mm-yyyy hh-mm-ss")
.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:="Z:\A\B\C\D\" & DateString1 & "\" & "İlr_" & DateString & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
    

 End With
    Cells.Select
    Selection.EntireColumn.Hidden = False


    Range("A:F,I:ax,CJ:KP").Select
    Selection.EntireColumn.Hidden = True
    'SÜTUNLARI SEÇ VE GİZLE
    
  End With
    ActiveSheet.PageSetup.PrintArea = "$G$2:$CI$" & sh
    With ActiveSheet.PageSetup
    .PrintQuality = 600
    .Orientation = xlLandscape
    .PaperSize = xlPaperA3
    .FitToPagesWide = 1
       Application.PrintCommunication = False
    ActiveSheet.PrintOut Copies:=xy
    
    With ActiveSheet
DateString = Format(Now, "dd-mm-yyyy hh-mm-ss")
.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:="Z:\A\B\C\D\" & DateString1 & "\" & "KKK_" & DateString & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False



End With
  Sheets("EK").Select
    With ActiveSheet.PageSetup
    .PrintQuality = 600
    .Orientation = xlLandscape
    .PaperSize = xlPaperA3
    .FitToPagesWide = 1
    Application.PrintCommunication = False
    ActiveSheet.PrintOut Copies:=xy
 
With ActiveSheet
DateString = Format(Now, "dd-mm-yyyy hh-mm-ss")
.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:="Z:\A\B\C\D\" & DateString1 & "\" & "EK_" & DateString & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False



End With
End With
End With

  End With
    Sheets("GT").Select
    Cells.Select
    Selection.EntireColumn.Hidden = False
    Selection.EntireRow.Hidden = False
    If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData
    Range("G3").Select
    MsgBox "Rapor Yazıldı. Yazıcıya Gidebilirsin...", vbInformation
    MsgBox "Z:\A\B\C\D\bugünün tarihi olan klasörde pdf leri bulabilirsiniz...", vbInformation

End Sub
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,243
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Kodlarınızdaki şu satırın altına DateString1 = Format(Now, "dd-mm-yyyy")

Aşağıdaki kodları ekleyiniz.

Kod: 
    If Dir("Z:\A\B\C\D\" & DateString1, vbDirectory) <> "" Then
        MsgBox "Aynı isimle klasör var, klasör oluşturulamadı...", vbCritical
        Exit Sub
    End If
 
E

euphrates55

Katılım
25 Ocak 2006
Mesajlar
763
Excel Vers. ve Dili
2019 tr
Altın Üyelik Bitiş Tarihi
04-01-2024
Kod: 
Sub raporyaz()
Dim ds
Set ds = CreateObject("Scripting.FileSystemObject")
DateString1 = Format(Now, "dd-mm-yyyy")
 If Dir("Z:\_a\b\c\d\e\" & DateString1, vbDirectory) <> "" Then
    MsgBox "Aynı İsimde Klasör var, klasör oluşturulamıyor... Mevcut Klasörün İsmini Değiştirerek Tekrar Deneyiniz...", vbCritical
    Exit Sub
    End If
ds.CreateFolder "Z:\_a\b\c\d\e\" & DateString1
    xy = InputBox("KAÇ KOPYA OLACAK")
        If xy = "" Then
    MsgBox "başlangıç hücresini yazmadınız.", vbCritical, "        Uyarı"
    Exit Sub
    End If
 sh = InputBox("GT sekmesinde çıktı alınacak son satır sayısı (harfsiz)")
    If sh = "" Then
MsgBox "son satır numarasını yazmadınız.", vbCritical, "        Uyarı"
Exit Sub
End If
.
.
.
.
If Dir("Z:\_a\b\c\d\e\" & DateString1, vbDirectory) <> "" Then
MsgBox "Aynı İsimde Klasör var, klasör oluşturulamıyor... Mevcut Klasörün İsmini Değiştirerek Tekrar Deneyiniz...", vbCritical

bu kısmı "Aynı isimde klasör var, mevcut klasörü silmek istermisiniz?" msgbox ile evet hayır seçenekleri ekleyerek evet seçilmesi durumunda o klasörün silinerek işlemlerin devam etmesi, hayır dersek işlemden çıkılması ve klasörün açılması için ne yapmalıyım?
 
Korhan Ayhan

Korhan Ayhan

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

Kod: 
If Dir("Z:\_a\b\c\d\e\" & DateString1, vbDirectory) <> "" Then
    Onay =MsgBox"Aynı isimde klasör var, mevcut klasörü silmek ister misiniz?", vbCritical + vbYesNo)

    If Onay = vbYes Then
       CreateObject("Scripting.FileSystemObject").DeleteFolder ""Z:\_a\b\c\d\e\" & DateString1"
    Else
       Exit Sub
    End If
End If
 
E

euphrates55

Katılım
25 Ocak 2006
Mesajlar
763
Excel Vers. ve Dili
2019 tr
Altın Üyelik Bitiş Tarihi
04-01-2024
Korhan Ayhan' Alıntı:
Deneyiniz.

Kod: 
If Dir("Z:\_a\b\c\d\e\" & DateString1, vbDirectory) <> "" Then
    Onay =MsgBox"Aynı isimde klasör var, mevcut klasörü silmek ister misiniz?", vbCritical + vbYesNo)

    If Onay = vbYes Then
       CreateObject("Scripting.FileSystemObject").DeleteFolder ""Z:\_a\b\c\d\e\" & DateString1"
    Else
       Exit Sub
    End If
End If
Genişletmek için tıkla ...
teşekkürler. evet oldu

Kod: 
.
.
.
End With
    Sheets("GT").Select
    Cells.Select
    Selection.EntireColumn.Hidden = False
    Selection.EntireRow.Hidden = False
    If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData
    Range("G3").Select
    MsgBox "Rapor Yazıldı. Yazıcıya Gidebilirsin...", vbInformation
    MsgBox "Z:\_a\b\c\d\e\bugünün tarihi olan klasörde pdf leri bulabilirsiniz...", vbInformation
End Sub
bu kodun sonunda
MsgBox "Z:\_a\b\c\d\e\bugünün tarihi olan klasörde pdf leri bulabilirsiniz...", vbInformation kısmından sonra tamama bastığımızda klasörün açılması için ne ekleyebiliriz peki. yani şu klasör. Z:\_a\b\c\d\e\bugünün tarihi
 
E

euphrates55

Katılım
25 Ocak 2006
Mesajlar
763
Excel Vers. ve Dili
2019 tr
Altın Üyelik Bitiş Tarihi
04-01-2024
end sub kısmının öncesine Shell "explorer Z:\a\b\c\d\e\" & DateString1, vbNormalFocus şeklinde kod ekliyorum ama e klasörü açılıyor. tanımlı olan DateString1 e karşılık gelen bugünün tarihi klasörünün içine giremedim bir türlü. tırnaklarla ilgili sorun yaşıyorum sanırım.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst