Word

'przy okazji pętla, przy użyciu VBA.Dir, która pod daną ścieżką (strP) wyszuka pliki o rozszerzeniu .doc?, czyli docm, docx, doc …
strF = Dir(strP & "\*.doc?") 'Change as required

While (strF <> "")

Debug.Print strP & "\" & strF ‘’’ctrl+g uruchamia immediate window, tam się drukują wyniki
If IsWorkBookOpen(strP & "\" & strF) = True Then 'opisana wyżej przy okazji excela (polecam zajrzeć)
E = E & ", " & strF 'zbiera otwarte pliki (w użyciu), można potem taką wiedzę wykorzystać, np wyświetlając potem w msgbox E
Else
Set myDocument = appWord.Documents.Open(strP & "\" & strF)
Call costamRob(myDocument) ' gdzieś tam można wstawić myDocument.SaveAs, np. .SaveAs2 FileName, 17 (PDF), który zapisze nam nowe okno pliku z nową nazwą pod wskazaną ścieżką
myDocument.Close False
End If
strF = Dir
Wend

'procedura, która w dokumencie Word odświeży wszystkie łącza (linki)
Sub UpdateLinks(doc As Word.Document)
doc.Fields.Update
doc.Save
End Sub

'znajduje wiersz w tabeli, który zawiera dany string
'For Each tbl In ThisDocument.Tables, funkcja jest wywoływana w pętli po tabelach
'związane jest to z większym projektem… długa historia
For Each tbl In ThisDocument.Tables
For Each tblRow In tbl.Rows

Set lastrow = findlastrow(tbl, CStr(startEnd(1)))
If Not lastrow is nothing Then
wstawprzycisk tblRow, "minus", CStr("Tag do przycisku"), CStr("wu wysyałem string, dzięki któremu ustalałem wielkość obrazka) 'minus to kod do wybrania później ścieżki do obrazka

else goto nextrow

End If
Next i
nextrow:
Next tblRow
Next tbl

Function findlastrow(tbl As Table, lastrow As String) As Row
Dim tblRow As Row

For Each tblRow In tbl.Rows
Debug.Print tblRow.Cells(1).Range.Text
If Left(tblRow.Cells(1).Range.Text, Len(lastrow)) = lastrow Then
Set findlastrow = tblRow
Exit Function
End If
Next
Set findlastrow = Nothing 'jezeli nie znalazł stringa, to nie przypisuję obiektu do wyniku funkcji
End Function

'wstawiam przycisk w dane miejsce, przypisujac mu tag, nadajac wielkosc oraz
'zmieniajac obrazek. Stale okreslaja sciezki do obrazkow
Function wstawprzycisk(tblRow As Row, jaki As String, taGG As String, fullTable As String)
Dim objcc As contentcontrol
Dim obrazek As String
tblRow.Select
If tblRow.Cells.Count = 1 Then tblRow.Range.Cells(1).Split , 2 ''dzeli wiersz na 2 kolumny

Set objcc = tblRow.Cells(2).Range.ContentControls.Add(wdContentControlPicture)
If jaki = "minus" Then obrazek = obrazekMinus Else obrazek = obrazekPlus ''mam constanty, wyglądające tak:
'Const obrazekMinus = "C:\Users\Mariusz\Pictures\Saved Pictures\pobrane.png"
'Const obrazekPlus = "C:\Users\Mariusz\Pictures\Saved Pictures\4Tb4GG7Ec.jpeg"
zmienobrazek objcc, obrazek, fullTable
objcc.tag = taGG

zmienobrazek objcc, obrazek, fullTable
objcc.tag = taGG
tblRow.Cells(komorka).Range.Font.Hidden = True
End Function

Sub zmienobrazek(objcc As contentcontrol, obrazek As String, fullTable As String)
Dim pPicFileName As String
Dim size As Long

If UCase(Right(fullTable, 1)) = "F" Then size = 15 Else size = 10
If objcc.Type = wdContentControlPicture Then
If objcc.Range.InlineShapes.Count > 0 Then objcc.Range.InlineShapes(1).Delete

ThisDocument.InlineShapes.AddPicture FileName:=obrazek, _
linktofile:=True, Range:=objcc.Range

objcc.Range.InlineShapes(1).ScaleHeight = size
objcc.Range.InlineShapes(1).ScaleWidth = size

End If
End Sub

'podmieniamy działanie przycisku ctrl+z, można odpalić taką procedurkę przy otwarciu :⟩

Sub keybindin()
FindKey(BuildKeyCode(wdKeyControl, wdKeyZ)).Rebind wdKeyCategoryMacro, "msgboxNoWay"
ThisDocument.ActiveWindow.View.ShowAll = True
'ThisDocument.ActiveWindow.View.ShowHiddenText = True

End Sub

Sub msgboxNoWay()
MsgBox "Nie można cofnąć zmian"
End Sub

'dwie przykładowe procedurki na ContentControl’ach
'pierwsza dodaje itemy do listy rozwijanej
Sub fillwithData(values() As String, objcc As contentcontrol)
Dim i As Long
For i = LBound(values) To UBound(values)
objcc.DropdownListEntries.Add values(i)
Next
End Sub
'a druga wyszukuje w danej controlce pewien tekst, jeżeli go odnajdzie zaznacza I wychodzi z pętli (dropdownList)
Sub chooseFromDropdown(objcc As contentcontrol, val As String)
Dim i As Long
For i = 1 To objcc.DropdownListEntries.Count
If StrComp(UCase(objcc.DropdownListEntries(i).Text)
UCase(val)) = 0 Then 'strcomp()= 0 to dopasowanie 100%
objcc.DropdownListEntries(i).Select
Exit For
End If

Next
End Sub

'’prosta funkcja, która wynajdzie tabelę, bazując na tekstach zawartych w kolumnie 1 i 1 wierszu
Function findTable(tekst As String) As Long
For tbl = 1 To ThisDocument.Tables.Count
Debug.Print ThisDocument.Tables(tbl).Cell(1, 1).Range.Text
If Left(ThisDocument.Tables(tbl).Cell(1, 1).Range.Text, Len(tekst)) = tekst Then

findTable = tbl
Exit For
End If
Next

End Function