Find next inlineshape

[kkjensen]

Hi everyone,

I'm programming a script to go through a word document and find inlineshapes so alternative text can be added. Currently I do the following:
With ActiveDocument
For I = 1 To .InlineShapes.Count
Application.StatusBar = "Alternative Text for " & Rangename
If .InlineShapes(I).AlternativeText = blank Then
.InlineShapes(I).AlternativeText = Selection.Address(External:=True) & "-AKA-" & Rangename
End If
Next I
End With

This gets the job done but does a LOT of looping once there's a whole bunch of inlineshapes to loop through.

Is there a way, from the current cursor location, to find the next inlineshape? This would allow me to jump to the right chapter or bookmark, back up a couple pages (just to be sure) and start the loop. Since it would find what it needs sooner the amount of looping would be greatly reduced.

A million thanks in advance.

kindest regards,

kkjensen

 

[macropod]

Hi kkjensen,

Here's one way of starting your loop from the current selection & 'backing up' 5 paragraphs:

Dim oRng As Range, iShp As InlineShape
With ActiveDocument
  Set oRng = Selection.Range
  oRng.End = ActiveDocument.Range.End
  oRng.MoveStart wdParagraph, -5
  For Each iShp In oRng.InlineShapes
    Application.StatusBar = "Alternative Text for " & Rangename
    If iShp.AlternativeText = "" Then
      iShp.AlternativeText = Selection.Address(External:=True) & "-AKA-" & Rangename
    End If
  Next
End With

Cheers
[MS MVP - Word]

 

[macropod]

For the 'backing up' you might find it better to replace:
oRng.MoveStart wdParagraph, -5
with:

Dim i As Integer
  For i = 1 To 5
    If oRng.Previous Is Nothing Then Exit For
    oRng.MoveStart wdParagraph, -1
  Next

Cheers
[MS MVP - Word]

 

[kkjensen]

Perfect! You probably recognize this problem from the mrexcel forum (if you're the same macropod from that world).

Now that I have some code that does exactly what I need it to (without rediculous amouts of looping) I need to run it from an excel macro.

Here's what I modified it to so it would run in excel without throwing any error codes: Do you see any glaring mistakes?

Dim WDApp As Word.Application
Dim WDDoc As Word.Document
Dim iShp As Word.InlineShape
Dim oRng As Word.Range

Set WDApp = GetObject(, "Word.Application")
Set WDDoc = WDApp.ActiveDocument

With WDDoc
    Set oRng = WDApp.Selection.Range
    oRng.End = .Range.End
    For i = 1 To 5
        If oRng.Previous Is Nothing Then Exit For
        oRng.MoveStart wdParagraph, -1
    Next
    For Each iShp In oRng.InlineShapes
        Application.StatusBar = "Alternative Text for " & Rangename
        If iShp.AlternativeText = "" Then
            iShp.AlternativeText = Selection.Address(External:=True) & "-AKA-" & Rangename
            If .InlineShapes(i).Height > 530 Then
                 .InlineShapes(i).Width = 530 * .InlineShapes(i).Width / .InlineShapes(i).Height
                 .InlineShapes(i).Height = 530
            End If
        End If
    Next
End With

This is lightyears faster than my old looping one.

Thanks a million!!

 

[macropod]

Hi kkjensen,

As far as I can tell, the code is fine.

And yes, I'm the same 'macropod' you've encountered at Mr Excel.


Cheers
[MS MVP - Word]