Exporting multiple sheets to to Word based on User Input

Hi All,

I am working on a macro that exports Worksheets as Pictures to a Bookmark location in a MS Word Document. There are a couple of issues I would appreciate some help with:

Firstly, I would like the user to enter the number of worksheets to be exported. I would appreciate some code for this.

Secondly, if the target Word Document is already open then my macro goes into an endless loop 'Waiting for another program to respond' type error. Any suggestions on how I could improve my msoFileDialogFilePicker code to prevent this would be appreciated.

Sub Export_Worksheets()

' Export Worksheets

Dim stWordReport As String


'Select Word Doc Report
    With Application.FileDialog(msoFileDialogFilePicker)
    .InitialFileName = "C:"
    .AllowMultiSelect = False
    If .Show = True Then
    stWordReport = .SelectedItems(1)
    Else
    Exit Sub
    End If
 
    
    'Word objects.
    Dim wdApp As Word.Application
    Dim wdDoc As Word.Document
    Dim wdbmRange As Word.Range
    
    'Excel objects.
    Dim wbBook As Workbook
    Dim wsSheet As Worksheet
    Dim rnReport As Range
    
    'Initialize the Excel objects.
    Set wbBook = ThisWorkbook
    Set wsSheet = wbBook.Worksheets("WS1")
    'Need to code to allow multiple WS to be exported

    Set rnReport = wsSheet.Range("A1:M61")
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    
    
    'Selection.Copy
    'ActiveSheet.Pictures.Paste.Select
    'ActiveSheet.Shapes.Range(Array("Picture 1")).Select
    
    
    'Initialize the Word objects.
    Set wdApp = New Word.Application
    Set wdDoc = wdApp.Documents.Open(stWordReport)
    'Set wdDoc = wdApp.Documents.Open(wbBook.Path & "\" & stWordReport)
    Set wdbmRange = wdDoc.Bookmarks("BM1").Range
    
    'If the macro has been run before, clean up any artifacts before trying to paste the table in again.
    On Error Resume Next
    With wdDoc.InlineShapes(1)
        .Select
        .Delete
    End With
    On Error GoTo 0
    
    'Turn off screen updating.
    Application.ScreenUpdating = False
    
    'Copy the report to the clipboard.
    rnReport.Copy
    
    'Select the range defined by the "Report" bookmark and paste in the report from clipboard.
    With wdbmRange
        .Select
        .PasteSpecial Link:=False, _
                      DataType:=wdPasteMetafilePicture, _
                      Placement:=wdInLine, _
                      DisplayAsIcon:=False
    End With
    
    'Save and close the Word doc.
    With wdDoc
        .Save
        .Close
    End With
    
    'Quit Word.
    wdApp.Quit
    
    'Null out your variables.
    Set wdbmRange = Nothing
    Set wdDoc = Nothing
    Set wdApp = Nothing
    
    'Clear out the clipboard, and turn screen updating back on.
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
    
    MsgBox "The worksheet has successfully been transferred to" & vbNewLine & _
           "" & stWordReport, vbInformation


End With

End Sub