Wouter
02-19-2018, 06:46 AM
I'm working on a macro that corrects linked image dimensions for a lot of documents at once.
I managed to get it working for Word but fail on the Excel part.
I run the macro using a Word document, it traverses our folder structure and edits each file one by one, the following code is a snippet doing the Excel editing part.
The problem is that I get a Type mismatch error (13) on retrieving the shapes of the sheet (highlighed code below).
It should return a shape object, what else could it be?
If IsFileOpen(WDDocPath) Then
Debug.Print "*** FILE IN USE *** " & WDDocPath
Else
Dim NewWidth As Double
Dim NewHeight As Double
Dim Path As String
Dim oSec As Section
Dim oHeader As HeaderFooter
Dim oLogo As Word.InlineShape
Dim oShape As Shape
Dim oSubShape As Shape
Dim oSource As String
'''''''''''''''''''''''''''''''''''''''''''''''''''''
' BEGIN OF SETTINGS
' Dimensions in cm
NewWidth = 3.28
NewHeight = 1.01
' Absolute path to image link
Path = "logo.jpg"
' END OF SETTINGS
'''''''''''''''''''''''''''''''''''''''''''''''''''''
'Verify it being a WORD or EXCEL document and call the correct functions.
If WDDocPath Like "*.x*" Then
With Workbooks.Open(WDDocPath)
.Activate
Dim ws As Worksheet
Debug.Print WDDocPath
For Each ws In ActiveWorkbook.Worksheets
ws.Activate
Debug.Print ActiveSheet.Name
For Each oShape In ws.Shapes ' TYPE MISMATCH ERROR
Debug.Print oShape.Type
If oShape.Type = 12 Then
Debug.Print TypeName(oShape.OLEFormat.Object.Object)
End If
If oShape.Type = msoLinkedPicture Then
If ModifyFloatingShape(oShape, Path, NewWidth, NewHeight) Then
End If
End If
Next oShape
Next ws
.Close True
End With
'Debug.Print (WDDocPath)
Else
I managed to get it working for Word but fail on the Excel part.
I run the macro using a Word document, it traverses our folder structure and edits each file one by one, the following code is a snippet doing the Excel editing part.
The problem is that I get a Type mismatch error (13) on retrieving the shapes of the sheet (highlighed code below).
It should return a shape object, what else could it be?
If IsFileOpen(WDDocPath) Then
Debug.Print "*** FILE IN USE *** " & WDDocPath
Else
Dim NewWidth As Double
Dim NewHeight As Double
Dim Path As String
Dim oSec As Section
Dim oHeader As HeaderFooter
Dim oLogo As Word.InlineShape
Dim oShape As Shape
Dim oSubShape As Shape
Dim oSource As String
'''''''''''''''''''''''''''''''''''''''''''''''''''''
' BEGIN OF SETTINGS
' Dimensions in cm
NewWidth = 3.28
NewHeight = 1.01
' Absolute path to image link
Path = "logo.jpg"
' END OF SETTINGS
'''''''''''''''''''''''''''''''''''''''''''''''''''''
'Verify it being a WORD or EXCEL document and call the correct functions.
If WDDocPath Like "*.x*" Then
With Workbooks.Open(WDDocPath)
.Activate
Dim ws As Worksheet
Debug.Print WDDocPath
For Each ws In ActiveWorkbook.Worksheets
ws.Activate
Debug.Print ActiveSheet.Name
For Each oShape In ws.Shapes ' TYPE MISMATCH ERROR
Debug.Print oShape.Type
If oShape.Type = 12 Then
Debug.Print TypeName(oShape.OLEFormat.Object.Object)
End If
If oShape.Type = msoLinkedPicture Then
If ModifyFloatingShape(oShape, Path, NewWidth, NewHeight) Then
End If
End If
Next oShape
Next ws
.Close True
End With
'Debug.Print (WDDocPath)
Else