Does anyone know how to insert a PDF file as a picture. I have no problems with tifs, bmps or jpgs. But now that I have a new scanner that outputs PDFS I'm running into problems with PDFS.
Please Advise, Below is the code I use on one of my spreadsheets to insert the same picture on each tab of the workbook. I just added the PDF file types and it did not insert them
Thank You
Private Sub btnPicAll_Click()
Application.ScreenUpdating = False
Dim myPicture As Variant
Dim p As Object
Dim Factor As Single
myPicture = Application.GetOpenFilename _
("Pictures (*.gif; *.cgm; *.jpg; *.bmp; *.tif; *.pdf),*.gif; *.cgm; *.jpg; *.bmp; *.tif; *.pdf", _
, "Select Picture to Import")
If myPicture = False Then Exit Sub
For Each Page In Sheets
Page.Activate
Page.Range("BQ6").Select
ActiveSheet.Unprotect Password:="elvis1"
'DELETE THE OLD PICTURES
On Error Resume Next
Dim ShapeObject As Shape
For Each ShapeObject In ActiveSheet.Shapes
' Uncomment the following line to get a prompt of every shape object type.
' Write down all the Types it shows you, and use trial-and-error to figure out what type any given picture is.
' KNOWN TYPES: Form Buttons are Type 12, Drop Down Boxes are Type 8, JPegs and GIfs are Type 13
' The Message Box will pop-up for every shape it encounters, which may be dozens, so keep clicking "OK" until it finishes the loop
'MsgBox ShapeObject.Type
If ShapeObject.Type = 13 Or ShapeObject.Type = 7 Then
Call ShapeObject.Delete
End If
Next
'FINISHED DELETING OLD PICTURES
Range("BQ6").Select
Set p = ActiveSheet.Pictures.Insert(myPicture)
'Width and Height are in points (1/72 inch)
p.ShapeRange.LockAspectRatio = msoTrue
Hfactor = 4.91 / (p.Height / 72)
Wfactor = 5.96 / (p.Width / 72)
If Hfactor < Wfactor Then
Factor = Hfactor
Else
Factor = Wfactor
End If
p.Width = p.Width * Factor
p.Height = p.Height * Factor
ActiveSheet.Protect Password:="elvis1"
Next
Sheets("Project-Gate").Select
Application.ScreenUpdating = True
End Sub
Please Advise, Below is the code I use on one of my spreadsheets to insert the same picture on each tab of the workbook. I just added the PDF file types and it did not insert them
Thank You
Private Sub btnPicAll_Click()
Application.ScreenUpdating = False
Dim myPicture As Variant
Dim p As Object
Dim Factor As Single
myPicture = Application.GetOpenFilename _
("Pictures (*.gif; *.cgm; *.jpg; *.bmp; *.tif; *.pdf),*.gif; *.cgm; *.jpg; *.bmp; *.tif; *.pdf", _
, "Select Picture to Import")
If myPicture = False Then Exit Sub
For Each Page In Sheets
Page.Activate
Page.Range("BQ6").Select
ActiveSheet.Unprotect Password:="elvis1"
'DELETE THE OLD PICTURES
On Error Resume Next
Dim ShapeObject As Shape
For Each ShapeObject In ActiveSheet.Shapes
' Uncomment the following line to get a prompt of every shape object type.
' Write down all the Types it shows you, and use trial-and-error to figure out what type any given picture is.
' KNOWN TYPES: Form Buttons are Type 12, Drop Down Boxes are Type 8, JPegs and GIfs are Type 13
' The Message Box will pop-up for every shape it encounters, which may be dozens, so keep clicking "OK" until it finishes the loop
'MsgBox ShapeObject.Type
If ShapeObject.Type = 13 Or ShapeObject.Type = 7 Then
Call ShapeObject.Delete
End If
Next
'FINISHED DELETING OLD PICTURES
Range("BQ6").Select
Set p = ActiveSheet.Pictures.Insert(myPicture)
'Width and Height are in points (1/72 inch)
p.ShapeRange.LockAspectRatio = msoTrue
Hfactor = 4.91 / (p.Height / 72)
Wfactor = 5.96 / (p.Width / 72)
If Hfactor < Wfactor Then
Factor = Hfactor
Else
Factor = Wfactor
End If
p.Width = p.Width * Factor
p.Height = p.Height * Factor
ActiveSheet.Protect Password:="elvis1"
Next
Sheets("Project-Gate").Select
Application.ScreenUpdating = True
End Sub