Dosyayı PDF Olarak Yedeklemek

[1Al2Ver]

Merhaba,

Excel dosyamı aşağıdaki kod ile, yine excel olarak yedekliyorum,

Aşağıdaki kodun düzenlenerek, dosyanın PDF olarak yedeklenmesini rica ediyorum.

Teşekkür ederim.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set ds = CreateObject("Scripting.FileSystemObject")
ThisWorkbook.Save
yer = "D:\PDF_YEDEKLERİ"
If ds.FolderExists(yer) = False Then
ds.CreateFolder yer
End If
If ThisWorkbook.Path = yer Then Exit Sub
If MsgBox("Dosyanın yedeğini almak istiyor musunuz?", vbInformation + vbYesNo, "DURUM") = vbYes Then
dosyaadi = ThisWorkbook.FullName
uzanti = "." & ds.GetExtensionName(dosyaadi)
isim = Sheets("ANASAYFA").Cells(10, "b").Value 
yol = yer & "/" & Format(Now, " dd.mm.yyyy hh_nn_ss") & "-" & isim & uzanti
ds.CopyFile dosyaadi, yol
End If
End Sub

 

[hlojan]

Deneyiniz

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set ds = CreateObject("Scripting.FileSystemObject")
ThisWorkbook.Save
yer = "D:\PDF_YEDEKLERİ"
If ds.FolderExists(yer) = False Then
ds.CreateFolder yer
End If
If ThisWorkbook.Path = yer Then Exit Sub
If MsgBox("Dosyanın yedeğini almak istiyor musunuz?", vbInformation + vbYesNo, "DURUM") = vbYes Then
dosyaadi = ThisWorkbook.FullName
uzanti = "." & ds.GetExtensionName(dosyaadi)
isim = Sheets("ANASAYFA").Cells(10, "b").Value
yol = yer & "/" & Format(Now, " dd.mm.yyyy hh_nn_ss") & "-" & isim & uzanti
pdfx = yer & "/" & Format(Now, " dd.mm.yyyy hh_nn_ss") & "-" & isim
ds.CopyFile dosyaadi, yol
Worksheets("ANASAYFA").ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfx, Quality:=xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False


End If
End Sub

 

[1Al2Ver]

Sayın hlojan merhaba,

İlginiz ve çözüm için teşekkür ederim, sanırım bir detayı atlamışım,

Kod şu haliyle "ANASAYFA" yı PDF olarak yedekliyor,

Ben, tüm çalışma kitabını PDF olarak yedeklemek istiyorum,

Çalışma Kitabını yedeklemek için kodda gereken düzeltmeyi rica ediyorum.

Teşekkür ederim.

 

[hlojan]

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set ds = CreateObject("Scripting.FileSystemObject")
ThisWorkbook.Save
yer = "D:\PDF_YEDEKLERİ"
If ds.FolderExists(yer) = False Then
ds.CreateFolder yer
End If
If ThisWorkbook.Path = yer Then Exit Sub
If MsgBox("Dosyanın yedeğini almak istiyor musunuz?", vbInformation + vbYesNo, "DURUM") = vbYes Then
dosyaadi = ThisWorkbook.FullName
uzanti = "." & ds.GetExtensionName(dosyaadi)
isim = Sheets("ANASAYFA").Cells(10, "b").Value
yol = yer & "/" & Format(Now, " dd.mm.yyyy hh_nn_ss") & "-" & isim & uzanti
pdfx = yer & "/" & Format(Now, " dd.mm.yyyy hh_nn_ss") & "-" & isim 
ds.CopyFile dosyaadi, yol

         Dim WS_Count As Integer
         Dim I As Integer
         WS_Count = ActiveWorkbook.Worksheets.Count
    For I = 1 To WS_Count

ActiveWorkbook.Worksheets(I).ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfx & I, Quality:=xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  

         Next I

End If
End Sub

 

[1Al2Ver]

Sayın hlojan tekrar merhaba,

Aşağıdaki satırda hata aldım ;

ActiveWorkbook.Worksheets(I).ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfx & I, Quality:=xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

Ofis sürümünden mi kaynaklanıyor ?

 

[halit3]

ThisWorkbook.Worksheets.Select

pdf yapmadan önce bütün sayfaları seçmek lazım yukarıdaki kod bunu yapıyor.


kodun durumu bu olacak

[COLOR="Red"]ThisWorkbook.Worksheets.Select[/COLOR]

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfx, Quality:=xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

 

[1Al2Ver]

Sayın halit3 merhaba,

Öneriniz için teşekkür ederim,

Dosyada yedek alırken, "ANASAYFA" dışında kalan diğer sayfaların Visible özelliği VeryHidden olduğundan, bu sayfalar görünmüyor , dolayısıyla da kod hata veriyor,

Bunu daha önceki kod'da (1 nolu mesajdaki, dosyayı excel olarak yedekleyen) yaşamadığım için istek yaparken belirtmemiştim,

Kod'u bir başka dosyada denedim, sorun çıkmadı,

Sanırım ihtiyacım olan komut ; Tüm VeryHidden olan sayfaları açması, sonrasında yedeklemesi ve "Yedekleme sonrası, dosya kapanmadan önce açılan sayfaları yine VeryHidden yapması ve kapatması" şeklinde.

Tekrar teşekkür ederim.

 

[hb3102]

Tüm Dosyadaki verileri Pdf yapma

Excell içerisinde bulunan ekteki ikon tüm sayfaları pdf yapıyor siz oradan istediğiniz yere kaydedersiniz.

 

[1Al2Ver]

Excell 2010 içerisinde bulunan ekteki ikon tüm sayfaları pdf yapıyor siz oradan istediğiniz yere kaydedersiniz.

Sayın hb3102 merhaba,

İlginiz ve öneriniz için teşekkür ederim,

Amacım, aşağıdaki komutu koddan kaldırıp, dosyayı otomatik olarak PDF formatında yedekletmek,

If ThisWorkbook.Path = yer Then Exit Sub
If MsgBox("Dosyanın yedeğini almak istiyor musunuz?", vbInformation + vbYesNo, "DURUM") = vbYes Then

Bu nedenle mevcut kod'a çözüm arıyorum,


Tekrar teşekkür ederim.

 

[halit3]

Sheets(Array("Sayfa1", "Sayfa2", "Sayfa3", "Sayfa4")).Select

Böyle bir şey yap
Yazılı sayfaları seç pdf yap

 

[1Al2Ver]

Sayın halit3 merhaba,

Cevap ve yönlendirme için teşekkür ederim,

1 nolu mesajdaki kodu siz yazmış ve bana yardımcı olmuştunuz, ben kod yazmıyorum, ancak anladığım olursa, basit düzenlemeler yapıyorum,

Bu nedenle 1 nolu koda gerekli ilave ve/veya düzenlemeyi de yapamadım,

Her şey için bir kere daha teşekkür ederim.

 

[halit3]

kod:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set ds = CreateObject("Scripting.FileSystemObject")
ThisWorkbook.Save
yer = "D:\PDF_YEDEKLERİ"
If ds.FolderExists(yer) = False Then
ds.CreateFolder yer
End If
If ThisWorkbook.Path = yer Then Exit Sub
If MsgBox("Dosyanın yedeğini almak istiyor musunuz?", vbInformation + vbYesNo, "DURUM") = vbYes Then
dosyaadi = ThisWorkbook.FullName
uzanti = "." & ds.GetExtensionName(dosyaadi)
isim = Sheets("ANASAYFA").Cells(10, "b").Value
yol = yer & "/" & Format(Now, " dd.mm.yyyy hh_nn_ss") & "-" & isim & uzanti
ds.CopyFile dosyaadi, yol

Sheets(Array("ANASAYFA", "Sayfa2", "Sayfa3", "Sayfa4")).Select

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=yer & "/" & Format(Now, " dd.mm.yyyy hh_nn_ss") & "-" & isim & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False

End If
End Sub

 

[halit3]

Bu kod sayfaları kendi seçiyor

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set ds = CreateObject("Scripting.FileSystemObject")
ThisWorkbook.Save
yer = "D:\PDF_YEDEKLERİ"
If ds.FolderExists(yer) = False Then
ds.CreateFolder yer
End If
If ThisWorkbook.Path = yer Then Exit Sub
If MsgBox("Dosyanın yedeğini almak istiyor musunuz?", vbInformation + vbYesNo, "DURUM") = vbYes Then
dosyaadi = ThisWorkbook.FullName
uzanti = "." & ds.GetExtensionName(dosyaadi)
isim = Sheets("ANASAYFA").Cells(10, "b").Value
yol = yer & "/" & Format(Now, " dd.mm.yyyy hh_nn_ss") & "-" & isim & uzanti
ds.CopyFile dosyaadi, yol

Dim myArray() As Variant
n = 0
For i = 1 To ActiveWorkbook.Sheets.Count
If Sheets(i).Visible = -1 Then
ReDim Preserve myArray(n)
myArray(n) = i
n = n + 1
End If
Next i

[COLOR="Red"]Sheets(myArray).Select[/COLOR]

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=yer & "/" & Format(Now, " dd.mm.yyyy hh_nn_ss") & "-" & isim & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False

End If
End Sub

 

[1Al2Ver]

Sayın halit3 merhaba,

Öncelikle zahmetleriniz için teşekkür etmek istiyorum,

VeryHidden olarak 2 sayfayı gizledim, kodu çalıştırdım,

"ANASAYFA" sayfası açık olduğundan sadece bu sayfa yedeklendi,

Ayrıca kod, yedeklemeyi hem PDF hem de .xlsm olarak yedekliyor.

Dosya ek'tedir.

Tekrar teşekkür ederim.

 

[halit3]

şimdi ne demek istediğinizi tam anlamadım siz dosyada gizli sayfalar hariç bütün sayfaları sadece pdf olarak kayıt mı yapmak istiyorsunuz.

mevcut kod hem excell dosya xlsm olarak yedekliyor hemde pdf olarak gizli sayfalar hariç kayıt yapıyor.

 

[halit3]

birde bu kodu dene

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set ds = CreateObject("Scripting.FileSystemObject")
ThisWorkbook.Save
yer = "D:\PDF_YEDEKLERİ"

If ds.FolderExists(yer) = False Then
ds.CreateFolder yer
End If

If MsgBox("Dosyanın yedeğini almak istiyor musunuz?", vbInformation + vbYesNo, "DURUM") = vbYes Then
isim = Sheets("ANASAYFA").Cells(10, "b").Value

Dim myArray() As Variant
n = 0
For I = 1 To ActiveWorkbook.Sheets.Count
If Sheets(I).Visible = -1 Then
ReDim Preserve myArray(n)
myArray(n) = I
n = n + 1
End If
Next I

Sheets(myArray).Select

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=yer & "/" & Format(Now, " dd.mm.yyyy hh_nn_ss") & "-" & isim & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End If
End Sub

 

[1Al2Ver]

Sayın halit3 tekrar merhaba,

Bana çözüm bulmak için çaba sarf ediyorsunuz, çok teşekkür ederim, sanırım ben sorunumu tam ifade edemedim,

Tekrarlamak gerekirse , "ANASAYFA" sayfası sürekli açık,

Diğer sayfaların Visible özelliği VeryHidden, dolayısyla görünmüyorlar,

Olabiliyor ise ;

Kod, "ANASAYFA" dahil, tüm VeryHidden sayfaları da PDF formatında yedeklesin istiyorum,

Teşekkür ederim.

 

[halit3]

kod:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set ds = CreateObject("Scripting.FileSystemObject")
'ThisWorkbook.Save
yer = "D:\PDF_YEDEKLERİ"

ReDim sayf(100)

If ds.FolderExists(yer) = False Then
ds.CreateFolder yer
End If

If MsgBox("aaaDosyanın yedeğini almak istiyor musunuz?", vbInformation + vbYesNo, "DURUM") = vbYes Then
isim = Sheets("ANASAYFA").Cells(10, "b").Value

For i = 1 To ActiveWorkbook.Sheets.Count
If Sheets(i).Visible = 0 Then
Sheets(i).Visible = -1
sayf(i) = 1
End If
Next i

[COLOR="Red"]If ActiveWorkbook.Sheets.Count > 1 Then
ThisWorkbook.Worksheets.Select
End If[/COLOR]

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=yer & "/" & Format(Now, " dd.mm.yyyy  hh_nn_ss") & "-" & isim & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False

For j = 1 To ActiveWorkbook.Sheets.Count
If Val(sayf(j)) = 1 Then
Sheets(j).Visible = 0
End If
Next j
ThisWorkbook.Save
End If
End Sub

 

[1Al2Ver]

Sayın halit3 merhaba,

Kodu 14 nolu mesaj ekindeki dosyama uyguladığımda, aşağıdaki satır hata veriyor, neden olabilir ?

ThisWorkbook.Worksheets.Select

 

[halit3]

Bunu dene

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set ds = CreateObject("Scripting.FileSystemObject")
'ThisWorkbook.Save
yer = "D:\PDF_YEDEKLERİ"

ReDim sayf(100)

If ds.FolderExists(yer) = False Then
ds.CreateFolder yer
End If

If MsgBox("aaaDosyanın yedeğini almak istiyor musunuz?", vbInformation + vbYesNo, "DURUM") = vbYes Then
isim = Sheets("ANASAYFA").Cells(10, "b").Value

For i = 1 To ActiveWorkbook.Sheets.Count

If Sheets(i).Visible = 2 Then
Sheets(i).Visible = -1
sayf(i) = 1
End If
Next i

If ActiveWorkbook.Sheets.Count > 1 Then
ThisWorkbook.Worksheets.Select
End If

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=yer & "/" & Format(Now, " dd.mm.yyyy  hh_nn_ss") & "-" & isim & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False

For j = 1 To ActiveWorkbook.Sheets.Count
If Val(sayf(j)) = 1 Then
Sheets(j).Visible = 2
End If
Next j
ThisWorkbook.Save
End If
End Sub