Excel to Pdf

cagataybaser

New Member
Joined
Jul 28, 2014
Messages
34
Hello,
I have one excel sheet which has pictures inside and I need to create button to excel to pdf and the pictures shouldnt get bigger when I changed it.
Thank you very much.
 

Some videos you may like

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.

ChrisBM

Board Regular
Joined
Sep 22, 2014
Messages
215
<code style="margin: 0px; padding: 0px; border: 0px; vertical-align: baseline; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, serif; white-space: inherit; background-image: initial; background-attachment: initial; background-size: initial; background-origin: initial; background-clip: initial; background-position: initial; background-repeat: initial;">Here is some vba code to save the current sheet to pdf:

Code:
ActiveSheet.ExportAsFixedFormat _
         Type:=xlTypePDF, _        
         Filename:=[COLOR=#800000]"C:\Sheet.pdf"[/COLOR], _        
         Quality:=xlQualityStandard, _
         IncludeDocProperties:=[COLOR=#800000]True[/COLOR], _        
         IgnorePrintAreas:=[COLOR=#800000]False[/COLOR], _
         OpenAfterPublish:=[COLOR=#800000]True
[/COLOR]
</code>
 

ParamRay

Well-known Member
Joined
Aug 6, 2014
Messages
1,195
.
.

Try the following procedure:

Code:
Sub ExportAsPDF()

    Dim Ini As String
    Dim FNm As Variant
    Dim Shp As Shape
    Dim Top As Long
    Dim Btm As Long
    Dim Lft As Integer
    Dim Rgt As Integer
    
    If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
    
    With ActiveWorkbook
        Ini = .Path & Application.PathSeparator
        If InStr(.Name, ".") = 0 Then
            Ini = Ini & .Name
        Else
            Ini = Ini & Left(.Name, InStr(.Name, ".") - 1)
        End If
    End With
    
    FNm = Application.GetSaveAsFilename( _
        InitialFileName:=Ini, _
        FileFilter:="Adobe Acrobat Document (*.pdf), *.pdf", _
        Title:="Save As")
    
    If FNm = False Then Exit Sub
    
    With ActiveSheet
        Top = .Rows.Count
        Lft = .Columns.Count
    End With
    
    Btm = 1
    Rgt = 1
    
    For Each Shp In ActiveSheet.Shapes
        
        With Shp.TopLeftCell
            If .Row < Top Then Top = .Row
            If .Column < Lft Then Lft = .Column
        End With
        
        With Shp.BottomRightCell
            If .Row > Btm Then Btm = .Row
            If .Column > Rgt Then Rgt = .Column
        End With
    
    Next Shp
    
    With ActiveSheet
        .PageSetup.PrintArea = .Range(Cells(Top, Lft), Cells(Btm, Rgt)).Address
    End With
    
    Application.PrintCommunication = False
    
    With ActiveSheet.PageSetup
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    
    Application.PrintCommunication = True
    
    On Error Resume Next
    ActiveSheet.ExportAsFixedFormat _
        Type:=xlTypePDF, _
        Filename:=FNm, _
        IgnorePrintAreas:=False, _
        OpenAfterPublish:=True
    
    If Err.Number <> 0 Then
        MsgBox _
            Prompt:= _
                "The action can't be completed because the file is open in Adobe Reader" & _
                vbCrLf & vbCrLf & "Close the file and try again.", _
            Buttons:=vbExclamation, _
            Title:="File In Use"
    End If
    On Error GoTo 0

End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,108,630
Messages
5,523,989
Members
409,553
Latest member
alscno

This Week's Hot Topics

Top