Word bookmarks in to array and sheets in to other Array

[KVT Holland]

Hi,


I've been doing some VBA stuff lately but i don't know what directions to take.

Is there a better way to read in the BookMarks and how can i get them to link get the right sheet in this line;

    MyArray(i) 
    'needs to go in to;
    wb.ws.range("A1:BA3000")

I've been spending way to many hours on the array part. It should be really easy.

    Private Sub ranges()
    
    Dim NamedRange As name
        Dim nm As name
        Dim ws As Worksheet
    
        Dim Lr As Long
        Dim Lc As Long
        Dim Rng As range
        Dim Bm As name
        Dim wb As Workbook
        Dim Fill As range
        Dim wd As Word.Application
    Set wd = New Word.Application
        Set wb = ThisWorkbook 'Workbooks("C:\Excel")
        Set aWs = ActiveSheet
    'array with names of the word bookmarks
            Dim myArray(38)
    
    myArray(0) = ("Tappunten")
    myArray(1) = ("test1")
    myArray(2) = ("Groslijst")
    myArray(3) = ("J01_2")
    myArray(4) = ("D01")
    myArray(5) = ("D03")
    myArray(6) = ("W01")
    myArray(7) = ("W02")
    myArray(8) = ("W03")
    myArray(9) = ("W04")
    myArray(10) = ("M01")
    myArray(11) = ("M03")
    myArray(12) = ("M04")
    myArray(13) = ("M05")
    myArray(14) = ("HJ01")
    myArray(15) = ("J01")
    myArray(16) = ("M02")
    myArray(17) = ("J03")
    myArray(18) = ("J04")
    myArray(19) = ("J05")
    myArray(20) = ("J06")
    myArray(21) = ("J07")
    myArray(22) = ("J08")
    myArray(23) = ("J09")
    myArray(24) = ("J10")
    myArray(25) = ("J11")
    myArray(26) = ("J12")
    myArray(27) = ("J13")
    myArray(28) = ("J14")
    myArray(29) = ("J15")
    myArray(30) = ("OT03")
    myArray(31) = ("OT06")
    myArray(32) = ("OT07")
    myArray(33) = ("Checklist")
    myArray(34) = ("ObjectGegevens")
    myArray(35) = ("Grondstof")
    myArray(36) = ("Drinkwaterinstallatie")
    myArray(37) = ("WTB")
    myArray(38) = ("Warmwaterleidingnet")
    
        'array for the worksheets on the excel sheets
            Dim myArray2(38)
    
    myArray2(0) = Worksheets(1).name
    myArray2(1) = Worksheets(1).name
    myArray2(2) = Worksheets(42).name
    myArray2(3) = Worksheets(17).name
    myArray2(4) = Worksheets(2).name
    myArray2(5) = Worksheets(15).name
    myArray2(6) = Worksheets(22).name
    myArray2(7) = Worksheets(3).name
    myArray2(8) = Worksheets(28).name
    myArray2(9) = Worksheets(29).name
    myArray2(10) = Worksheets(4).name
    myArray2(11) = Worksheets(6).name
    myArray2(12) = Worksheets(29).name
    myArray2(13) = Worksheets(46).name
    myArray2(14) = Worksheets(7).name
    myArray2(15) = Worksheets(16).name
    myArray2(16) = Worksheets(5).name
    myArray2(17) = Worksheets(13).name
    myArray2(18) = Worksheets(12).name
    myArray2(19) = Worksheets(47).name
    myArray2(20) = Worksheets(9).name
    myArray2(21) = Worksheets(13).name
    myArray2(22) = Worksheets(14).name
    myArray2(23) = Worksheets(14).name
    myArray2(24) = Worksheets(32).name
    myArray2(25) = Worksheets(1).name
    myArray2(26) = Worksheets(1).name
    myArray2(27) = Worksheets(1).name
    myArray2(28) = Worksheets(1).name
    myArray2(29) = Worksheets(8).name
    myArray2(30) = Worksheets(19).name
    myArray2(31) = Worksheets(33).name
    myArray2(32) = Worksheets(18).name
    myArray2(33) = Worksheets(27).name
    myArray2(34) = Worksheets(25).name
    myArray2(35) = Worksheets(36).name
    myArray2(36) = Worksheets(26).name
    myArray2(37) = Worksheets(20).name
    myArray2(38) = Worksheets(38).name
  


    i = 1


    For Each nm In ThisWorkbook.Names
        If nm.Visible Then
            Set NamedRange = wb.Names.Item(i)
            Set ws = NamedRange.RefersToRange.Parent
        End If
             
            Lr = wb.ws.range("A1:BA3000").Find(What:="*", LookIn:=xlValues, _
                SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
                SearchFormat:=False).Row
            Lc = wb.ws.range("A1:BA3000").Find(What:="*", LookIn:=xlValues, _
                SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, _
                SearchFormat:=False).Column
                
        Set Rng = ws.range(ws.Cells(1, 1), ws.Cells(Lr, Lc))
    
    With wd
            .Visible = True
            .WindowState = wdWindowStateMaximize
        With .Documents.Add(Template:="C:\RABP sjabloon clean.dotx")
            With .Bookmarks
                myArray(i).range.PasteExcelTable LinkedToExcel:=False, _
                    WordFormatting:=True, RTF:=False
                Rng.Copy ws.range(i)
            End With
        End With
    End With
            i = i + 1
        Next nm
    End Sub

 

[Macropod]

Perhaps you could explain what you're trying to achieve? As your code stands, I don't see the point of creating & populating myArray2, as it's never used for anything. I also can't see the point of adding a new document on each loop and populating a different bookmark, instead of updating all the bookmarks in the same document.

 

[KVT Holland]

Hey,

I think i misunderstood how i could use the array for my goals. I have many different named ranges and some need to go to a BookMark in word. I thought loading the named ranges and bookmarks onto an array would be a good way to cycle through each one. Instead i should have gone and "Dim and set" the needed ranges and then load the ranges into the word doc. "for worksheet(1, 3, 11, 42...) find last row and column. Set rng1, 2, 3, 4...= range(A1, cells(lastCol, lastRow)). Then -> rng1.coppy item("bookmark1").range.PasteExcelTable.

 

[Macropod]

Well, if you have many named ranges and their names are the same as the Word bookmarks, it's really very simple:

Sub Demo()
'Note: A reference to the Word library must be set, via Tools|References
Dim wdApp As New Word.Application, wdDoc As Word.Document, i As Long
Const StrDocNm As String = "C:\RABP sjabloon clean.dotx"
If Dir(StrDocNm) = "" Then Exit Sub
Set wdDoc = wdApp.Documents.Add(Template:=StrDocNm)
wdApp.Visible = True
With ThisWorkbook
  For i = 1 To .Names.Count
    .Names(i).RefersToRange.Copy
    Call PasteBookmark(wdDoc, .Names(i).Name)
  Next
End With
Set wdDoc = Nothing: Set wdApp = Nothing
End Sub

Sub PasteBookmark(wdDoc As Word.Document, strBkMk As String)
Dim wdRng As Word.Range
With wdDoc
  If .Bookmarks.Exists(strBkMk) Then
    Set wdRng = .Bookmarks(strBkMk).Range
    wdRng.Paste
    .Bookmarks.Add strBkMk, wdRng
  End If
End With
Set wdRng = Nothing
End Sub

 

[KVT Holland]

Wow, thanks!

That's so amazing! It what I wanted to do, didn't know how to do so. I really appreciate it!!!!

1056 google search results only got me a small way, the 2 posts you answered dit 99%.

I wish i started learning VBA sooner.

 

[Macropod]

1056 google search results only got me a small way

I don't know what you searched for, but I did a quick one and the first four hits, in order, were:
https://stackoverflow.com/questions...ge-values-to-doc-bookmarks-then-export-to-pdf
http://www.vbaexpress.com/kb/getarticle.php?kb_id=381
https://www.experts-exchange.com/qu...e-from-Excel-to-Word-bookmarks-using-VBA.html
https://www.mrexcel.com/forum/excel...vba-save-word-doc-same-location-workbook.html

 

[KVT Holland]

Most of the searches are just "vba 101" searches. I actually found 2 of the results you posted, but failed to understand them.

Learnt a lot (actually glad i didn't switch to the mail merge you mentioned earlier). Actually made a lot of improvements to
the sheets i'm working on.

Thanks a lot!