2

VBA を使用してプログラムで Word テンプレート レポートの Excel テーブルを更新したいと考えています。テーブルは、Matlab のテンプレート Excel ファイルの複数のシートに書き込まれます。ファイル構造は次のようになります。ここに画像の説明を入力

コードは、フォルダー構造をチェックして、Excel ファイルが最新のフォルダーから取り出されているかどうかを確認する必要があります。そうであれば、すべてのセルを更新するだけです。そうでない場合は、すべてのテーブルを削除し、前のテーブルがプルされたのと同じシートから新しいテーブルを挿入する必要があります。以下のアスタリスクの間のコードがわかりません。どんな助けでも大歓迎です。

Sub LinkToCurrentTableFolder()
'Get current folder by date
Dim clientTablesPath As Variant
filePath = ActiveDocument.Path & "\ClientTables\"

Set fso = CreateObject("Scripting.FileSystemObject")
Set fld = fso.GetFolder(filePath)
Dim currentFolder As Variant: currentFolder = ""
For Each sf In fld.SUBFOLDERS
    'Look at name and get current date
    If currentFolder = "" Then
        currentFolder = sf.Path
    ElseIf sf.Path > currentFolder Then
        currentFolder = sf.Path
    End If
Next
'***
'Debug: display current Excel folder path
'MsgBox (currentFolder)
If currentPath = currentFolder Then
'Loop through all tables in document and refresh
'If path is not current delete current table
Dim tbTemp As Table
Dim cellTemp As Cell
    For Each tbTemp In ActiveDocument.Tables
    For Each cellTemp In tbTemp.Range.Cells
    cellTemp.Range.Fields.Update
    Next
    Next
Else
'Locate same file name in new folder
shpName = .LinkFormat.SourceName
 NewPath = currentFolder & "\" & shpName
'Delete existing table (???) Not sure
.Delete
'Create new table (???) Not sure - must be from same location and same size as previous one
Selection.Table.AddOLEObject ClassType:=cType, FileName:=NewPath, LinkToFile:=True, DisplayAsIcon:=False
End If
'***
End Sub

編集 - 以下に示すように、コピーと貼り付けが行われます。 ここに画像の説明を入力

4

1 に答える 1

2

ここで答えを見つけました。このコードは、新しい Excel ファイルの場所を要求し、Excel リンク テーブルのすべてのフィールド コードを更新します。

そのリンクのコードは以下のとおりです。

Public Sub changeSource()
Dim dlgSelectFile As FileDialog 'FileDialog object '
Dim thisField As Field
Dim selectedFile As Variant
'must be Variant to contain filepath of selected item
Dim newFile As Variant
Dim fieldCount As Integer '
Dim x As Long
On Error GoTo LinkError
'create FileDialog object as File Picker dialog box
Set dlgSelectFile = Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
With dlgSelectFile
   .Filters.Clear 'clear filters
  .Filters.Add "Microsoft Excel Files", "*.xls, *.xlsb, *.xlsm, *.xlsx" 'filter for o    nly Excel files
  'use Show method to display File Picker dialog box and return user's action
  If .Show = -1 Then
 'step through each string in the FileDialogSelectedItems collection
    For Each selectedFile In .SelectedItems
         newFile = selectedFile 'gets new filepath
       Next selectedFile
     Else 'user clicked cancel
   Exit Sub
  End If
End With
Set dlgSelectFile = Nothing
'update fields
With ActiveDocument
  fieldCount = .Fields.Count
  For x = 1 To fieldCount
    With .Fields(x)
     'Debug.Print x '
     Debug.Print .Type
      If .Type = 56 Then
        'only update Excel links. Type 56 is an excel link
        .LinkFormat.SourceFullName = newFile '
        .Update
        .LinkFormat.AutoUpdate = False
        DoEvents
      End If
    End With
  Next x
End With
MsgBox "Source data has been successfully imported."
Exit Sub
LinkError:
Select Case Err.Number
  Case 5391 'could not find associated Range Name
    MsgBox "Could not find the associated Excel Range Name " & _
      "for one or more links in this document. " & _
      "Please be sure that you have selected a valid " & _
      "Quote Submission input file.", vbCritical
      Case Else
        MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical
    End Select
End Sub
于 2013-11-01T20:51:49.733 に答える