Pdf olarak kaydetmek

[aydogankemal]

Merhabalar,
Excel dosyamı, işim bittikten sonra bir buton aracılığı ile pdf olarak kaydetmek istiyorum,
Dosya yolu Excel dosyasının olduğu klasör ile aynı olacak,
Dosya adı ise otomatik olarak Excel dosyasındaki K1 hücresinin adı olacak.
Şimdiden yardım eden arkadaşlara teşekkür ederim

 

[yanginci34]

Denermisiniz

Sub Düğme1_Tıkla()
   If [k1] = "" Then
      MsgBox ("k1 hücresi boş devam edilemez")
      Exit Sub
   End If
   Set shsayfa = ActiveSheet
   yol = ActiveWorkbook.Path & "\" & [k1]
   shsayfa.ExportAsFixedFormat Type:=xlTypePDF, Filename:=yol, Quality:=xlQualityStandard, _
             IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub

 

[ewrencell]

Teşekkürler paylaşım için. Bu sitede, özellikle VBA kısmında harika işler paylaşılıyor.

Bu başlığı biraz ileriye götürecek bir sorum olacak:
Dosyamda; 1, 2, 3, 4, 5 isimli sayfalar var diyelim. Bu sayfaların formatı aynı ya da benzer. Her sayfanın da (örneğin) Z1 hücresi ya boş ya da "1". Soru şu ki; excel tüm sayfalara baksın ve Z1 hücresi "1" olan sayfaları pdf olarak kaydetsin, Z1 hücresi boş olan sayfaları almasın.
(Not: her sayfa için ayrı pdf yapsa da olur, tek pdf dosyasına toptan yazdırsa da olur.)

Destek için şimdiden teşekkürler.

 

[halit3]

B u kodu bir dene

Teşekkürler paylaşım için. Bu sitede, özellikle VBA kısmında harika işler paylaşılıyor.

Bu başlığı biraz ileriye götürecek bir sorum olacak:
Dosyamda; 1, 2, 3, 4, 5 isimli sayfalar var diyelim. Bu sayfaların formatı aynı ya da benzer. Her sayfanın da (örneğin) Z1 hücresi ya boş ya da "1". Soru şu ki; excel tüm sayfalara baksın ve Z1 hücresi "1" olan sayfaları pdf olarak kaydetsin, Z1 hücresi boş olan sayfaları almasın.
(Not: her sayfa için ayrı pdf yapsa da olur, tek pdf dosyasına toptan yazdırsa da olur.)

Destek için şimdiden teşekkürler.

Sub pdfaktar()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
yer = ActiveSheet.Name

Dim myArray() As Variant
m = 0
For j = 1 To ActiveWorkbook.Sheets.Count

aranan = Sheets(Sheets(j).Name).Cells(1, "z")
If aranan = 1 Then
ReDim Preserve myArray(m)
myArray(m) = Sheets(j).Name
m = m + 1
End If
Next

If m = 0 Then Exit Sub
Sheets(myArray).Select
Sheets(myArray).Copy

For i = 1 To ActiveWorkbook.Sheets.Count
Sheets(Sheets(i).Name).Select
ActiveSheet.DrawingObjects.Delete
Next

Dim Yol As String
Application.DisplayAlerts = False
Yol = ThisWorkbook.Path
Say = CreateObject("Scripting.FileSystemObject").getfolder(Yol).Files.Count + 1

ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Yol & "\" & Say & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False

ActiveWindow.Close

Sheets(yer).Select

Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "İşlem Tamam", vbInformation, " U Y A R I "
End Sub