Excel Seçili Alanı Macro ile PDF olarak kaydetme

S

suat65

Katılım
7 Mart 2017
Mesajlar
29
Excel Vers. ve Dili
2011
Merhaba,

Aşağıdaki kodda seçili alanı (Yani örnek olarak; A11 ile J50 arasını PDF olarak kaydetmek istiyorum. Yardımcı olabilir misiniz.

Teşekkür Ederim

Sub PDFActiveSheet()
'www.contextures.com
'for Excel 2010 and later
Dim wsA As Workbook
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler

Set wbA = ActiveWorkbook
Set wsA = ActiveWorkbook


'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"

'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " _ ", "")
strName = Replace(strName, ".", "_")

'create default name for savng file
strFile = strTime & " " & strName & ".pdf"
strPathFile = strPath & strFile

'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")

'export to PDF if a folder was selected
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF oluşturuldu: " _
& vbCrLf _
& myFile
End If

exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
 
M

murat_fidan

Katılım
20 Ekim 2021
Mesajlar
104
Excel Vers. ve Dili
TR 2016
Altın Üyelik Bitiş Tarihi
21-10-2022
suat65' Alıntı:
Merhaba,

Aşağıdaki kodda seçili alanı (Yani örnek olarak; A11 ile J50 arasını PDF olarak kaydetmek istiyorum. Yardımcı olabilir misiniz.

Teşekkür Ederim

Sub PDFActiveSheet()
'www.contextures.com
'for Excel 2010 and later
Dim wsA As Workbook
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler

Set wbA = ActiveWorkbook
Set wsA = ActiveWorkbook


'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"

'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " _ ", "")
strName = Replace(strName, ".", "_")

'create default name for savng file
strFile = strTime & " " & strName & ".pdf"
strPathFile = strPath & strFile

'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")

'export to PDF if a folder was selected
If myFile <> "False" Then
wsA.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF oluşturuldu: " _
& vbCrLf _
& myFile
End If

exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
Genişletmek için tıkla ...
Kod: 
Sub pdf()
dosya_adı = "pdf" & Format(Now, " ddmmyyyy_hhnn")

If dosya_adı = "" Then

MsgBox "Dosya adı yok"

Exit Sub

End If

Kaynak = "C:\Users\" & Environ("UserName") & "\Desktop\"

If Right(Kaynak, 1) <> "\" Then

End If

yer = Kaynak & dosya_adı

 

Range("A11:J50").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
yer, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

MsgBox " SAYFANIZ MASAUSTUNE PDF OLARAK KAYDEDILMISTIR"

End Sub
 
S

suat65

Katılım
7 Mart 2017
Mesajlar
29
Excel Vers. ve Dili
2011
Hocam elinize sağlık. Benim attığım kod ile Excel ismiyle kaydediyordu ve PDF'i kaydedeceğim yeri seçmeme olanak sağlıyordu. Bu şekilde nasıl oluşturabilirim.
 
M

murat_fidan

Katılım
20 Ekim 2021
Mesajlar
104
Excel Vers. ve Dili
TR 2016
Altın Üyelik Bitiş Tarihi
21-10-2022
suat65' Alıntı:
Hocam elinize sağlık. Benim attığım kod ile Excel ismiyle kaydediyordu ve PDF'i kaydedeceğim yeri seçmeme olanak sağlıyordu. Bu şekilde nasıl oluşturabilirim.
Genişletmek için tıkla ...
Kod: 
Sub Makro1()
'for Excel 2010 and later
Dim wsA As Workbook
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler

Set wbA = ActiveWorkbook
Set wsA = ActiveWorkbook


'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"

'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " _ ", "")
strName = Replace(strName, ".", "_")

'create default name for savng file
strFile = strTime & " " & strName & ".pdf"
strPathFile = strPath & strFile

'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")

Range("A11:J50").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
yer, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False



exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
 
M

murat_fidan

Katılım
20 Ekim 2021
Mesajlar
104
Excel Vers. ve Dili
TR 2016
Altın Üyelik Bitiş Tarihi
21-10-2022
Deneme yanılma yoluyla bir şeyler yapmaya çalıştım sizin paylaşmış olduğunuz makro üzerinden umarım işinize yarar
 
S

suat65

Katılım
7 Mart 2017
Mesajlar
29
Excel Vers. ve Dili
2011
Hocam zahmet oldu, Allah razı olsun. Çalıştı macro. Çok teşekkürler
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst