Consulting

Results 1 to 3 of 3

Thread: Traverse all images in workbook

  1. #1
    VBAX Newbie
    Joined
    Feb 2018
    Posts
    1
    Location

    Traverse all images in workbook

    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

  2. #2
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    Avoid declaring variables.
    Avoid 'select' and 'activate' in VBA.
    Do not nest Word & Excel
    Use indentation to make your code readable.

    For Each it In sheets
      for Each it1 In it.Shapes
        select case it1.type
        case 11
    
        case 12
    
        end select
      Next
    Next

  3. #3
    VBAX Expert Dave's Avatar
    Joined
    Mar 2005
    Posts
    832
    Location
    Maybe this bit of code will get U started. HTH. Dave
    Sub test()
    Dim Sh As Shape
    With Sheets("Sheet1")
    For Each Sh In .Shapes
    If Application.Version > 12 Then
    If Sh.Type = 11 Then
    MsgBox Sh.Name
    End If
    Else
    If Sh.Type = 13 Then
    MsgBox Sh.Name
    End If
    End If
    Next Sh
    End With
    End Sub

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •