Running my macro freeze the ribbon

I have written a macro to insert multiple JPEGs into a word document, resize them, position them on the page and then alter the page orientation and size accordingly.

The macro runs fine and completes the task but once it is finished the ribbon freezes and nothing can be selected. I can move through the document and edit pages but cannot acces the ribbon at all.

Exiting the document, saving and reopening the ribbon returns and the document seems uaffected?

It seems that the macro is not finishing properly or something?

here is the VB macro code...

Sub AddMuliplePictures()

    'Declare a variable as a FileDialog object.

    Dim fd As FileDialog

    Dim num As String
    Dim i As Integer
    i = 0


    'Create a FileDialog object as a File Picker dialog box.

    Set fd = Application.FileDialog(msoFileDialogFilePicker)



    'Declare a variable to contain the path

    'of each selected item. Even though the path is a String,

    'the variable must be a Variant because For Each...Next

    'routines only work with Variants and Objects.

    Dim vrtSelectedItem As Variant



    'Use a With...End With block to reference the FileDialog object.

    With fd



        'Add a filter that includes GIF and JPEG images and make it the second item in the list.

        .Filters.Add "Images", "*.gif; *.jpg; *.jpeg"



        'Sets the initial file filter to number 2.

        .FilterIndex = 2



        'Use the Show method to display the File Picker dialog box and return the user's action.

        'If the user presses the action button...

        If .Show = -1 Then



            'Step through each string in the FileDialogSelectedItems collection.

            For Each vrtSelectedItem In .SelectedItems



                'vrtSelectedItem is a String that contains the path of each selected item.


                Selection.InlineShapes.AddPicture FileName:=vrtSelectedItem, LinkToFile:=False, SaveWithDocument:=True
                i = i + 1
                Set myDoc = ActiveDocument.InlineShapes
                a = myDoc(i).Height
                b = myDoc(i).Width
                If a < b Then

                Selection.PageSetup.PaperSize = wdPaperA3
                Selection.PageSetup.Orientation = wdOrientLandscape
                Selection.PageSetup.PaperSize = wdPaperA4
                Selection.PageSetup.Orientation = wdOrientPortrait
                End If
                Selection.InsertBreak Type:=wdSectionBreakNextPage

            Next vrtSelectedItem

        'If the user presses Cancel...


        End If

    End With



    'Set the object variable to Nothing.

    Set fd = Nothing


For Each ishape In ActiveDocument.InlineShapes

oh = ishape.Height

ow = ishape.Width

If oh > ow Then

ishape.Height = 841.9

ishape.Width = 594.72


ishape.Height = 841.9

ishape.Width = 1191.07

End If


Next ishape


For Each nshape In ActiveDocument.Shapes

nshape.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage

nshape.Left = 0

nshape.RelativeVerticalPosition = wdRelativeVerticalPositionPage

nshape.Top = 0

Next nshape


End Sub


Question Info

Last updated November 19, 2017 Views 540 Applies to:

Well I have recently had the marco complete without freezing word, so I closed all the programs I had running and tried again and all was fine... tried a third time for luck and it froze... So i think it has something to do with the capacity of the computer and whatever is running in the background, networking, virus scanning etc manipulating all those images at once seems to freak word out if it doesnt have enough processing power... perhaps we can call that the solution and I will request a better computer from IT ;)


Thanks for all your assistance and patience


Did this solve your problem?

Sorry this didn't help.

Great! Thanks for marking this as the answer.

How satisfied are you with this reply?

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

How satisfied are you with this response?

Thanks for your feedback.