Vba Kodu İle Exceli Pdf Ye Çevirmek

Mümkün müdür

Excelin neyini çevireceksiniz.Tüm sayfalarımı,belirli sayfalarımı?

Konu hakkınca bence yüzlerce örnek vardır internet deryasında.

Pdf olarak saklayacağım ama exceldeki yerleşim bozulmadan yapmak istiyorum

Print Selection To PDF

Kod:
Sub PrintSelectionToPDF()

'SUBROUTINE: PrintSelectionToPDF

'DEVELOPER: Ryan Wells

'DESCRIPTION: Print your currently selected range to a PDF

Dim ThisRng As Range

Dim strfile As String

Dim myfile As Variant

If Selection.Count = 1 Then

Set ThisRng = Application.InputBox("Select a range", "Get Range", Type:=8)

Else

Set ThisRng = Selection

End If

'Prompt for save location

strfile = "Selection" & "_" _

& Format(Now(), "yyyymmdd_hhmmss") _

& ".pdf"

strfile = ThisWorkbook.Path & "\" & strfile

myfile = Application.GetSaveAsFilename _

(InitialFileName:=strfile, _

FileFilter:="PDF Files (*.pdf), *.pdf", _

Title:="Select Folder and File Name to Save as PDF")

If myfile <> "False" Then 'save as PDF

ThisRng.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _

myfile, Quality:=xlQualityStandard, IncludeDocProperties:=True, _

IgnorePrintAreas:=False, OpenAfterPublish:=True

Else

MsgBox "No File Selected. PDF will not be saved", vbOKOnly, "No File Selected"

End If

End Sub

Print One Table To PDF

Kod:
Sub PrintTableToPDF()

'SUBROUTINE: PrintTableToPDF

'DEVELOPER: Ryan Wells

'DESCRIPTION: Print a table of your choosing to a PDF

Dim strfile As String

Dim myfile As Variant

Dim strTable As String, r As Range

Application.ScreenUpdating = False

'Enter the table name you want to save

strTable = InputBox("What's the name of the table you want to save?", "Enter Table Name") 'Table you want to save

If Trim(strTable) = "" Then Exit Sub

'Prompt for save location

strfile = strTable & "_" _

& Format(Now(), "yyyymmdd_hhmmss") _

& ".pdf"

strfile = ThisWorkbook.Path & "\" & strfile

myfile = Application.GetSaveAsFilename _

(InitialFileName:=strfile, _

FileFilter:="PDF Files (*.pdf), *.pdf", _

Title:="Select Folder and File Name to Save as PDF")

If myfile <> "False" Then 'save as PDF

Range(strTable).ExportAsFixedFormat Type:=xlTypePDF, Filename:=myfile, Quality:=xlQualityStandard, _

IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

Else

MsgBox "No File Selected. PDF will not be saved", vbOKOnly, "No File Selected"

End If

Application.DisplayAlerts = False

LetsContinue:

With Application

.ScreenUpdating = True

.DisplayAlerts = True

End With

Exit Sub

End Sub

Print All Tables To Separate PDFs

Kod:
Sub PrintAllTablesToPDFs()

'SUBROUTINE: PrintAllTablesToPDFs

'DEVELOPER: Ryan Wells

'DESCRIPTION: Print each table in your spreadsheet to a different PDF

Dim strTables() As String

Dim strfile As String

Dim ch As Object, sh As Worksheet

Dim icount As Integer

Dim myfile As Variant

Dim tbl As ListObject

Dim sht As Worksheet

With Application.FileDialog(msoFileDialogFolderPicker)

.Title = "Where do you want to save your PDF?"

.ButtonName = "Save Here"

.InitialFileName = ThisWorkbook.Path

If .Show = -1 Then ' if OK is pressed

sfolder = .SelectedItems(1)

Else

End

End If

End With

For Each sht In ThisWorkbook.Worksheets

For Each tbl In sht.ListObjects

myfile = ThisWorkbook.Name & "" & tbl.Name & "" _

& Format(Now(), "yyyymmdd_hhmmss") _

& ".pdf"

myfile = sfolder & "\" & myfile

sht.Range(tbl.Name).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _

myfile, Quality:=xlQualityStandard, IncludeDocProperties:=True, _

IgnorePrintAreas:=False, OpenAfterPublish:=True

Next tbl

Next sht

End Sub

Print All Sheets To One PDF

Kod:
Sub PrintAllSheetsToPDF()

'SUBROUTINE: PrintAllSheetsToPDF

'DEVELOPER: Ryan Wells

'DESCRIPTION: Combine all your worksheets into one PDF

Dim strSheets() As String

Dim strfile As String

Dim sh As Worksheet

Dim icount As Integer

Dim myfile As Variant

'Save Chart Sheet names to an Array

For Each sh In ActiveWorkbook.Worksheets

If sh.Visible = xlSheetVisible Then

ReDim Preserve strSheets(icount)

strSheets(icount) = sh.Name

icount = icount + 1

End If

Next sh

If icount = 0 Then 'No charts found. Punch error

MsgBox "A PDF cannot be created because no sheets were found.", , "No Sheets Found"

Exit Sub

End If

'Prompt for save location

strfile = "Sheets" & "_" _

& Format(Now(), "yyyymmdd_hhmmss") _

& ".pdf"

strfile = ThisWorkbook.Path & "\" & strfile

myfile = Application.GetSaveAsFilename _

(InitialFileName:=strfile, _

FileFilter:="PDF Files (*.pdf), *.pdf", _

Title:="Select Folder and File Name to Save as PDF")

If myfile <> "False" Then 'save as PDF

ThisWorkbook.Sheets(strSheets).Select

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _

myfile, Quality:=xlQualityStandard, IncludeDocProperties:=True, _

IgnorePrintAreas:=False, OpenAfterPublish:=True

Else

MsgBox "No File Selected. PDF will not be saved", vbOKOnly, "No File Selected"

End If

End Sub

Print Chart Sheets To PDF

Kod:
Sub PrintChartSheetsToPDF()

'SUBROUTINE: PrintChartSheetsToPDF

'DEVELOPER: Ryan Wells

'DESCRIPTION: Combine all chart sheets into one PDF

Dim strSheets() As String

Dim strfile As String

Dim ch As Object, sh As Worksheet

Dim icount As Integer

Dim myfile As Variant

'Save Chart Sheet names to an Array

For Each ch In ActiveWorkbook.Charts

ReDim Preserve strSheets(icount)

strSheets(icount) = ch.Name

icount = icount + 1

Next ch

If icount = 0 Then 'No charts found. Punch error

MsgBox "A PDF cannot be created because no Chart Sheets were found.", , "No Chart Sheets Found"

Exit Sub

End If

'Prompt for save location

strfile = "Charts" & "_" _

& Format(Now(), "yyyymmdd_hhmmss") _

& ".pdf"

strfile = ThisWorkbook.Path & "\" & strfile

myfile = Application.GetSaveAsFilename _

(InitialFileName:=strfile, _

FileFilter:="PDF Files (*.pdf), *.pdf", _

Title:="Select Folder and File Name to Save as PDF")

If myfile <> "False" Then 'save as PDF

ThisWorkbook.Sheets(strSheets).Select

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _

myfile, Quality:=xlQualityStandard, IncludeDocProperties:=True, _

IgnorePrintAreas:=False, OpenAfterPublish:=True

Else

MsgBox "No File Selected. PDF will not be saved", vbOKOnly, "No File Selected"

End If

End Sub

Print Chart Objects To PDF

Kod:
Sub PrintChartsObjectsToPDF()

'SUBROUTINE: PrintChartsObjectsToPDF

'DEVELOPER: Ryan Wells

'DESCRIPTION: Combine all chart objects into one PDF

Dim ws As Worksheet, wsTemp As Worksheet

Dim chrt As ChartObject

Dim tp As Long

Dim strfile As String

Dim myfile As Variant

Application.ScreenUpdating = False

Set wsTemp = Sheets.Add

tp = 10

With wsTemp

For Each ws In ActiveWorkbook.Worksheets

If ws.Name = wsTemp.Name Then GoTo nextws:

For Each chrt In ws.ChartObjects

chrt.Copy

wsTemp.Range("A1").PasteSpecial

Selection.Top = tp

Selection.Left = 5

If Selection.TopLeftCell.Row > 1 Then

ActiveSheet.Rows(Selection.TopLeftCell.Row).PageBreak = xlPageBreakManual

End If

tp = tp + Selection.Height + 50

Next

nextws:

Next ws

End With

'Prompt for save location

strfile = "Charts" & "_" _

& Format(Now(), "yyyymmdd\_hhmmss") _

& ".pdf"

strfile = ActiveWorkbook.Path & "\" & strfile

myfile = Application.GetSaveAsFilename _

(InitialFileName:=strfile, _

FileFilter:="PDF Files (*.pdf), *.pdf", _

Title:="Select Folder and File Name to Save as PDF")

If myfile <> False Then 'save as PDF

wsTemp.ExportAsFixedFormat Type:=xlTypePDF, Filename:=myfile, Quality:=xlQualityStandard, _

IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

'Else

' MsgBox "No File Selected. PDF will not be saved", vbOKOnly, "No File Selected"

End If

Application.DisplayAlerts = False

wsTemp.Delete

With Application

.ScreenUpdating = True

.DisplayAlerts = True

End With

Exit Sub

End Sub

Vba Kodu İle Exceli Pdf Ye Çevirmek

accessman

feraz

accessman