VBA Code to Create PDF Thumbnails?

[Billy Hill]

My work laptop has been replaced with a machine with Windows Vista. One of my macros grabs a bunch of links to PDF files from our server and copies them to a folder and opens the folder with big thumbnails. The thumbnails on Vista don't get created like they used to and I've heard Adobe has not desire to do anything about it. The entire reason I created the macro is so I could quickly scan through the thumbnails in Windows Explorer and perhaps put them in an email or open them or whatever. Is there any way I can generate thumbnails each time I populate the folder? Thanks!

 

[repairman615]

The first thing that comes to mind is to make sure the correct rectangle is being referenced. The code as posted uses "Rectangle 1".
Did you already catch this?

Would you post the code you are using?

Also I suppose if for some reason the file is coming out exactly double there could be a /2 added in to halve the width.

Seems strange though, I am using 2007 here and it does cover the rectangle like it should.

On a last thought, try it out in a new workbook, that could help trouble shoot. Just make one rectangle and see if the dbl width occurs again.

 

[tgrunwald]

Here is the code I am using, I apologize, I cannot remember how to use the code tags here.:

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

 

[repairman615]

Yes to the two lines, try and comment out the two scale lines that you suspect ('Problem?)and then test for the double width.

Basically, the top and left set the upper left corner, and then the width and height set their respective attributes making any scale not needed. As you thought, I am also thinking this is where the width problem is occuring.

-Jeff

 

[tgrunwald]

Even with those lines commented out, it still creates a PDF that is too wide the first couple times. After I clear the form and do it again it will create them the right size. this is boggling me.

Option Explicit
Sub LoadIncomingInvoice()
        
Dim myPDFobj        As OLEObject
Dim strFile         As String

    On Error Resume Next
            ' Get the path of the PDF
             strFile = Application.GetOpenFilename(FileFilter:= _
                    "Adobe Acrobat Files (*.pdf), *.pdf", Title:= _
                    "Please select a file")
            '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 1").Top
                    .Left = ActiveSheet.Shapes("Rounded Rectangle 1").Left
                    .Width = ActiveSheet.Shapes("Rounded Rectangle 1").Width
                    .Height = ActiveSheet.Shapes("Rounded Rectangle 1").Height
                    .Name = "IncomingInvoice"
                End With

    On Error GoTo 0
strFile = vbNullString
End Sub

Try this on a blank sheet....just make a smallish rounded rectangle shape, and see if it loads correctly....

 

[wigi]

The code in #24 works correctly in my testing. It creates a rectangle shape (ActiveSheet.OLEObjects.Add).

What piece of code (please provide it in its whole) is NOT working as it should? What are the prerequisites to have before executing (what rectangle shape name, and so on). Then I'll be happy to test again.

 

[tgrunwald]

The code in #24 works correctly in my testing. It creates a rectangle shape (ActiveSheet.OLEObjects.Add).

What piece of code (please provide it in its whole) is NOT working as it should? What are the prerequisites to have before executing (what rectangle shape name, and so on). Then I'll be happy to test again.

I'm sorry that I can't seem to explain better but let me try.
I just created a blank workbook and put the above code in module 1.
I created a Rounded Rectangle name "Rounded Rectangle 1"
The Rounded Rectangle goes from A1 to C11 in shape.
I created a button that runs the sub. And when I press it it "should" fit into the Rounded Rectangle.

As soon as I open the workbook, and push the button, it will create a PDF that goes from A1 to a little past E11. I will then select the PDF and cut it out. I then push the button and choose the exact same PDF file and it fits into the rectangle.

It only happens the first time I choose a particular PDF, and it fixes itself after I cut that PDF and choose it again. I would be happy to send you the new workbook so that you can see what I mean.

Thanks again for this help.

 

[repairman615]

Hello,

I did create a new workbook with rounded rectangle 1, no problems.

Maybe throw in these at the end to see if it thinks the widths are the same.

 

[tgrunwald]

Throw in what at the end?

 

[repairman615]

oops.

MsgBox ActiveSheet.Shapes("Rounded Rectangle 1").Width
MsgBox ActiveSheet.Shapes("IncomingInvoice").Width

 

[wigi]

I perfectly understand the steps you do

But sorry to say, in my case it goes from A1 to C11. Right from the first time.

Please send the workbook to my email address moc.liamg#sileig.miw (you'll understand the email address, reverse it, and after a while I delete my post)