Ask a new question

VBA code to resize linked inlineshape objects

I have over 100 linked pictures in a Word 2007 document (Windows 7). Most of the pictures are screen shots stored as bit maps. They are accessible in VBA as inlineshape objects.

 

Sometimes when I edit one of the linked bitmaps, Word resizes the image in the document. Its assigned height and width seem randomly chosen. In another question I asked if there were Word options to avoid this behavior. In case there aren't (but I still hope there are) such options, I looked for a way to store my preferred sizes for each picture. I considered several approaches:

 

  1. Find a settable property of an inlineshape object which I could set to the dimensions, and that Word would not overwrite. Alas, I couldn't find one.
  2. Define a document variable that I could relate to a unique, auto-generated identifier of an inlineshape and store the dimensions in the variable. Alas, there does not seem to be an ID for inlineshape objects.
  3. Add a comment to each inlineshape object that contains the dimensions. This is my current preferred choice. I can create a comment, but I can't find it later. The rest of my question deals with this code, but if there are better ways to maintain a set of preferred dimensions for each inlineshape object, I will scrap this code in a heartbeat!

 

The following subroutine expects that a paragraph containing one or more inlineshapes objects has been selected.

If the dimensions are stored as a comment, the code would verify/reset the dimensions to match those in the comment.

If the dimensions comment cannot be found and the width is not approximately 4.9 inches, the code would ask me if the dimensions are right and add a comment if they are. (I haven't decided exactly what I want to do if they are not right, so, for now, I just exit from the subroutine.)

 

The problem is, after adding a comment to the inlineshape, the program does not find it. I suspect that the "If s.Range.Comments.Count > 0" test is not testing the right property. The Count property has a value of 0, even though the document appears to be displaying a comment. Does anybody have any suggestions?

 

Thanks in advance,

Jim

 

Sub SetSize()
  Set para = Selection.Paragraphs(1).Range
  GraphicSizeFound = False
  For Each s In para.InlineShapes
    If s.Range.Comments.Count > 0 Then
      For Each c In s.Range.Comments
        If Left(c.Text, 12) = "graphic_size" Then
          GraphicSizeFound = True
'         verify the size of the graphic, and, if different
'           reset the graphic's size.
          Exit For
        End If
      Next c
    End If
    If Not GraphicSizeFound Then
      If (Abs(PointsToInches(s.Width) - 4.9) > 0.05) Then
        s.Select              ' highlight the graphic
        Result = MsgBox("height = " & PointsToInches(s.Height) & vbCr & _
                        "width  = " & PointsToInches(s.Width) & vbCr & _
                        vbCr & _
                        "Is this size right?", _
                        vbYesNo)
        If Result = vbYes Then
          Size = "graphic_size w=" & s.Width & " h=" & s.Height
          ActiveDocument.Comments.Add Range:=s.Range, Text:=Size
        Else
'         Figure out what to do in this case, but for now:
          Exit Sub
        End If
      End If ' Approximately 4.9"
    End If ' not GraphicSizeFound
  Next s
End Sub

 

Answer
Answer
Rather than a comment, I'll suggest using the shape's Alternative Text. When you insert a picture, go to the Picture Tools tab and click the dialog launcher (the little arrow in the bottom right corner) of the Size group. The second tab in the Size dialog is Alt Text. The default there for a linked picture is the file path and name of the link, but you can add the text of your size data at the beginning.

The advantage of Alt Text is that it's an intrinsic property of the picture, unlike a comment attached to its range. That will let you use code like this:

Sub SetSize()
    Dim ILS As InlineShape
    Dim altText As String, altW As String, altH As String
    Dim pos As Long
   
    For Each ILS In ActiveDocument.InlineShapes
        altText = ILS.AlternativeText
        If Left(altText, 12) = "graphic_size" Then
            pos = InStr(altText, "w=")
            If pos > 0 Then
                pos = pos + 2
                While IsNumeric(Mid(altText, pos, 1))
                    altW = altW & Mid(altText, pos, 1)
                    pos = pos + 1
                Wend
            End If
            pos = InStr(altText, "h=")
            If pos > 0 Then
                pos = pos + 2
                While IsNumeric(Mid(altText, pos, 1))
                    altH = altH & Mid(altText, pos, 1)
                    pos = pos + 1
                Wend
            End If
           
            ILS.LockAspectRatio = msoTrue
            ILS.Width = CSng(altW)
            ' alternatively,
            ' ILS.Width = CSng(altW)
            ' ILS.Height = CSng(altH)
        Else
            ' do the size check and message box, etc.
            ILS.AlternativeText = "graphic_size w=" & ILS.Width & " h=" & ILS.Height & ILS.AlternativeText
        End If
    Next
End Sub

The code for extracting the measurements from the string is clunkier than necessary, but it will work regardless of what else is in the string or how malformed it might be.
_____________________________
https://jay-freedman.info

Was this reply helpful?

Sorry this didn't help.

Great! Thanks for your feedback.

How satisfied are you with this reply?

Thanks for your feedback, it helps us improve the site.

How satisfied are you with this reply?

Thanks for your feedback.

 
 

Question Info

Last updated October 5, 2021 Views 79 Applies to: