Resize Picture in Excel From Access 1

[Kiwiman]

I have a module that exports data from access to excel, adds a new sheet (for suuary data) and formats all sheets in excel.

I have managed to add the company logo onto the summary sheet, in cell A1, but the picture itself is too small to see (without manually resizing it).

I have tried many variations to get this picture resized but to no avail (the code falls down). The latest error message for the below is: "Object doesn't support this propoerty or method"

Any ideas on how I can get around this?

Your help is appreciated.

Stop
' ActiveSheet.Shapes("Picture 1").Select
         
        With xlSheet.Range("A1:A1") 'Works ok
            xlSheet.Pictures.Insert(stPicPath).Select 'Works ok - picture is inserted into correct location
        End With 'Works ok
            
        With xlSheet.Shapes("Picture 1") ' Works ok - picture is selected
            .ShapeRange.ScaleWidth 8.86, msoFalse, msoScaleFromTopLeft ' Fails
            .ShapeRange.ScaleHeight 8.86, msoFalse, msoScaleFromTopLeft 'I assume fails as same as above
        End With

 

[ck1999]

I know this goes against everybody here (almost) but try this

xlSheet.Shapes("Picture 1").select
selection.ShapeRange.ScaleWidth 8.86, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 8.86, msoFalse, msoScaleFromTopLeft


ck1999

 

[Kiwiman]

Thanks ck1999 - it worked a treat. I think I tried the Selection.shaperange as part of a With statement - didn't like it. Thanks very much for your help

 

[Kiwiman]

The code above works fine if the Excel app is closed, as part of the code opens excel if open, and does the necessary formatting. When inserting pictures in this way, they all get a name "Picture 1" in the different spreadsheets.

If however, Excel is already open, the first one will work ok (on the basis that no other picture inserts have gone on outside this program), but the subsequent statements will not as they will get a name like "Picture 2" etc.

How can we find the "Picture Name" dynamically so that the code will work regardless of whether Excel is open or not.

There will only be one picture insert in this file, always in the same location, on the same sheet.

Thanks again

 

[ck1999]

you should be able to loop through all shapes on a sheet and then do an if loop to determine if it is a picture.

this works in excel try to modify to workin access like you did above
Sub GetShapePropertiesSomeWs()
Dim sShapes As Shape
'Loop through all shapes on Worksheet
For Each sShapes In ActiveSheet.Shapes

lLoop = lLoop + 1
If Left(sShapes.Name, 7) = "Picture" Then
'your code
End If
Next sShapes


End Sub



ck1999

 

[Kiwiman]

I tried to get this code to work, but kept on failing. However, I managed to get it (the picture name) another way.

The resizing works perfectly when Excel is closed, but not when it is open. It fails at this point:

Selection.ShapeRange.ScaleWidth 8.86, msoFalse, msoScaleFromTopLeft

The error message I am now getting is:

"Object variable or With Block variable not set"

To date i have. Any ideas - your help to date has been great.

'Insert Company Logo

'Get the File path and set the doc name to be inserted
    strFile = "CeridianLogo_NO_FreedomBlueWhite.JPG" ' What is the file to be inserted
    stPicPath = FilePath(Forms!Switchboard.AppId) 'Get the default path
    stPicPath = stPicPath & "Help Documents\" ' Add the Help Documents folder
    stPicPath = stPicPath & strFile ' final path name of the picture



         Stop
        With xlSheet.Range("A1:A1") 'Works ok
            xlSheet.Pictures.Insert(stPicPath).Select 'Works ok - picture is inserted into correct location
           
        End With 'Works ok
   
       'Find the name of the shape
       'Found that in subsequent sheets the name of the inserted file is always "Picture 1"??
        Set stShape = xlSheet.Shapes(1)
            strShape = stShape.Name
        Set stShape = Nothing
            
        'Resize the Logo
        'Currently only works when the Excel App is completely closed
        xlSheet.Shapes(strShape).Select
        Selection.ShapeRange.ScaleWidth 8.86, msoFalse, msoScaleFromTopLeft
        Selection.ShapeRange.ScaleHeight 7.92, msoFalse, msoScaleFromTopLeft
                 
        
            
'Set other sheet formats - numbers
                        
        With xlSheet.Range("G7:G8")
            .NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
        End With

 

[Kiwiman]

I have stumbled across the answer, as opposed to knowing the exact reason why. It was partly a missing reference (Microsoft Office 11.0 Object Library) (I only had reference to the Microsoft Excel 11.0 Object Library), together with the With statement for the Shape.

Thanks for all your help.

My final code for this issue is below.

'Insert Company Logo

'Get the File path and set the doc name to be inserted
    strFile = "CeridianLogo_NO_FreedomBlueWhite.JPG" ' What is the file to be inserted
    stPicPath = FilePath(Forms!Switchboard.AppId) 'Get the default path
    stPicPath = stPicPath & "Help Documents\" ' Add the Help Documents folder
    stPicPath = stPicPath & strFile ' final path name of the picture



         Stop
        With xlSheet.Range("A1:A1") 'Works ok
            xlSheet.Pictures.Insert(stPicPath).Select 'Works ok - picture is inserted into correct location
           
        End With 'Works ok
   
       'Find the name of the shape
       'Found that in subsequent sheets the name of the inserted file is always "Picture 1"??
        Set stShape = xlSheet.Shapes(1)
            strShape = stShape.Name
            
        With stShape
            .ScaleWidth 8.86, msoFalse, msoScaleFromTopLeft
            .ScaleHeight 7.92, msoFalse, msoScaleFromTopLeft
        End With
        
        Set stShape = Nothing

 

[PHV]

Another way:
xlSheet.Pictures.Insert(stPicPath).Select
With xlSheet.Application.Selection.ShapeRange
.ScaleWidth 8.86, msoFalse, msoScaleFromTopLeft
.ScaleHeight 7.92, msoFalse, msoScaleFromTopLeft
End With

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886