- Katılım
- 25 Ocak 2006
- Mesajlar
- 763
- Excel Vers. ve Dili
- 2019 tr
- Altın Üyelik Bitiş Tarihi
- 04-01-2024
Kod:
Alt PrintChartSheetsToPDF ()
'SUBROUTINE: PrintChartSheetsToPDF
'GELİŞTİRİCİ: Ryan Wells
'TANIM: Tüm grafik sayfalarını bir PDF'ye birleştirin
Dim strSheets () As String
Dim strfile As String
Dim Ch As Object, Sh As Çalışma Sayfası
Sayı olarak Tepe Sayacı
Değişken olarak Dim myfile
'Grafik Sayfası adlarını bir Diziye Kaydet
Her satır için ActiveWorkbook.Charts'da
ReDim strSheets'i koru (icount)
StrSheets (icount) = ch.Name
Icount = icount + 1
Sonraki ch
Eğer icount = 0 Then 'Hiçbir çizelge bulunamadı. Punch hatası
MsgBox "Hiçbir Grafik Tablosu bulunamadığından bir PDF oluşturulamaz.", "No Chart Sheets Found"
Çıkış Sub
Son If
'Konum kaydetmek için sor
Strfile = "Grafikler" ve "_" _
& Biçimlendir (Şimdi (), "yyyymmdd_hhmmss") _
& ".pdf"
Strfile = ThisWorkbook.Path & "\" & strfile
Myfile = Application.GetSaveAsFilename _
(Başlangıç DosyasıAdı: = strfile, _
FileFilter: = "PDF Dosyaları (* .pdf), * .pdf", _
Title: = "PDF Olarak Kaydedilecek Klasör ve Dosya Adını Seçin")
Myfile <> "Yanlış" Sonra 'PDF olarak kaydedin
ThisWorkbook.Sheets (strSheets) .Select
ActiveSheet.ExportAsFixedFormat Türü: = xlTypePDF, Dosya adı: = _
Myfile, Kalite: = xlQualityStandard, IncludeDocProperties: = True, _
IgnorePrintAreas: = Yanlış, OpenAfterPublish: = True
Başka
MsgBox "Dosya Seçilmedi .PDF kaydedilemiyor", vbOKOnly, "No File Selected"
Son If
End Sub
