I am loading a PDF file into a worksheet. The PDF file is supposed to fit into a rounded rectangle shape when loaded.
When the workbook first is opened and the sub is run, it doubles the width of the PDF. But sometimes after trying just one time it fits into the rectangle. Other times I have to delete the PDF and rerun the sub multiple times before it loads correctly. Does anyone have any ideas?
Here is the code:
/code
Option Explicit
Sub LoadIncomingInvoice()
Dim myPDFobj As OLEObject
Dim strFile As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Sheet1.Unprotect Password:="FIGHT4LOVE"
On Error Resume Next
' Get the path of the PDF
strFile = Application.GetOpenFilename(FileFilter:= _
"Adobe Acrobat Files (*.pdf), *.pdf", Title:= _
"Please select a file")
' Store the path so we can print it later
Sheet1.Range("I100").Value = strFile
'Set the object
Set myPDFobj = ActiveSheet.OLEObjects.Add(Filename:= _
strFile, Link:=True, DisplayAsIcon:=False)
'Set the object properties, try and fit them into the space occupied by
''Rounded Rectangle 48' . This is where something bugs out. Whenever
'I start the program and call this sub, the PDF loads the first time twice as
'it should. But on subsequent loads, it fits just fine.
With myPDFobj
.Top = ActiveSheet.Shapes("Rounded Rectangle 46").Top
.Left = ActiveSheet.Shapes("Rounded Rectangle 46").Left
.Width = ActiveSheet.Shapes("Rounded Rectangle 46").Width
.Height = ActiveSheet.Shapes("Rounded Rectangle 46").Height
.ShapeRange.ScaleWidth 0.96, msoFalse, msoScaleFromTopLeft 'Problem?
.ShapeRange.ScaleHeight 1.05, msoFalse, msoScaleFromTopLeft 'Problem?
.Name = "IncomingInvoice"
End With
On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
'Load the logfile
Sheet1.Range("L29").Value = Now & ": "
Sheet1.Range("N29").Value = "Incoming Invoice loaded into the system by " & WindowsUser
Sheet1.Protect Password:="FIGHT4LOVE"
strFile = vbNullString
End Sub
/code
When the workbook first is opened and the sub is run, it doubles the width of the PDF. But sometimes after trying just one time it fits into the rectangle. Other times I have to delete the PDF and rerun the sub multiple times before it loads correctly. Does anyone have any ideas?
Here is the code:
/code
Option Explicit
Sub LoadIncomingInvoice()
Dim myPDFobj As OLEObject
Dim strFile As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
Sheet1.Unprotect Password:="FIGHT4LOVE"
On Error Resume Next
' Get the path of the PDF
strFile = Application.GetOpenFilename(FileFilter:= _
"Adobe Acrobat Files (*.pdf), *.pdf", Title:= _
"Please select a file")
' Store the path so we can print it later
Sheet1.Range("I100").Value = strFile
'Set the object
Set myPDFobj = ActiveSheet.OLEObjects.Add(Filename:= _
strFile, Link:=True, DisplayAsIcon:=False)
'Set the object properties, try and fit them into the space occupied by
''Rounded Rectangle 48' . This is where something bugs out. Whenever
'I start the program and call this sub, the PDF loads the first time twice as
'it should. But on subsequent loads, it fits just fine.
With myPDFobj
.Top = ActiveSheet.Shapes("Rounded Rectangle 46").Top
.Left = ActiveSheet.Shapes("Rounded Rectangle 46").Left
.Width = ActiveSheet.Shapes("Rounded Rectangle 46").Width
.Height = ActiveSheet.Shapes("Rounded Rectangle 46").Height
.ShapeRange.ScaleWidth 0.96, msoFalse, msoScaleFromTopLeft 'Problem?
.ShapeRange.ScaleHeight 1.05, msoFalse, msoScaleFromTopLeft 'Problem?
.Name = "IncomingInvoice"
End With
On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
'Load the logfile
Sheet1.Range("L29").Value = Now & ": "
Sheet1.Range("N29").Value = "Incoming Invoice loaded into the system by " & WindowsUser
Sheet1.Protect Password:="FIGHT4LOVE"
strFile = vbNullString
End Sub
/code
