mit VBA im MsWord die Links auf Tabellen in einer Excel-Tabelle aktualisieren

Ich verwende für die Zusammenstellung der Zahlen Excel, da viele Werte aus wenigen Eingaben errechnet werden. Den eigentlichen Bericht schreibe ich in Word, die Ergebnisse der Berechnungen sind per Links von Excel ins Word verknüpft.

Für ein neues Projekt kopiere ich die beiden Dateien (Word und Excel). Um die Links zu aktualisieren habe ich mir ein kleines VBA-Modul programmiert.

dieses funktioniert jetzt nicht mehr. Beim Debuggen ist mit Aufgefallen, dass das Objekt


ActiveDocument.Fields(iCnt).LinkFormat.SourceFullName = "\\xxxxx\yyyy.xlsm!Title!Z1S5:Z9S5"

ActiveDocument.Fields(iCnt).LinkFormat.SourceName = "Title!Z1S5:Z9S5"

ActiveDocument.Fields(iCnt).LinkFormat.SourcePath = "\\xxxxx\yyyy.xlsm!Title!Z1S5"


es müsste aber heissen:

ActiveDocument.Fields(iCnt).LinkFormat.SourceName = "yyyy.xlsm!Title!Z1S5:Z9S5Z9S5"

ActiveDocument.Fields(iCnt).LinkFormat.SourcePath = "\\xxxxx\"


das Modul funktioniert jetzt nicht mehr, was kann ich tun.


MfG

Alexander



Sourc code:

...

stPath = ActiveDocument.FullName


stPath = Left(stPath, InStrRev(stPath, "\"))

Set ofDialog = Application.FileDialog(msoFileDialogFilePicker)

With ofDialog
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Microsoft Excel 2010", "*.xlsm"
.Filters.Add "Microsoft Excel 2010", "*.xlsx"
.Filters.Add "Microsoft Excel", "*.xls"
.InitialView = msoFileDialogViewDetails
.InitialFileName = stPath
If .Show = True Then
strConnection = .SelectedItems(1)

Else
strConnection = ""
End If
End With

If LCase(Right(strConnection, 4)) <> ".xls" And LCase(Right(strConnection, 5)) <> ".xlsx" And LCase(Right(strConnection, 5)) <> ".xlsm" Then
MsgBox "No Microsoft Excel file specified!!", vbCritical + vbOKOnly
Exit Sub
End If


For iCnt = 1 To ActiveDocument.Fields.Count

With ActiveDocument.Fields(iCnt)
On Error GoTo NoXLSlink
stBookmark = .Code.Text
On Error GoTo 0
If InStr(1, stBookmark, "Excel.") <> 0 Then
stLinkSource = .LinkFormat.SourceFullName
.LinkFormat.SourceFullName = strConnection

'//Seitenorientierung ermitteln Anfang 07.02.2005
ActiveDocument.Fields(iCnt).ShowCodes = False
ActiveDocument.Fields(iCnt).Select
If Selection.PageSetup.Orientation = wdOrientLandscape Then
sPageWidth = 780
sPageHeight = 500
Else
sPageWidth = 500
sPageHeight = 780
End If

'//Höhe und Breite setzen Anfang 07.02.2005
On Error GoTo Error_InlineShape
sHeight = Selection.InlineShapes(1).Height '= 428.3
sWidth = Selection.InlineShapes(1).Width '= 779.55
If sHeight > sPageHeight Then
Selection.InlineShapes(1).Height = sPageHeight
Selection.InlineShapes(1).Width = sWidth / sHeight * sPageHeight
End If
If sWidth > sPageWidth Then
Selection.InlineShapes(1).Width = sPageWidth
Selection.InlineShapes(1).Height = sHeight / sWidth * sPageWidth
End If
On Error GoTo 0
End If
End With
Next

Exit Sub
NoXLSlink:

stBookmark = "NoLink"
Resume Next

Error_InlineShape:

'Selection.MoveUp Unit:=wdLine, Count:=1, Extend:=wdExtend
Resume

...