0

次のことを行うマクロを作成しようとしています。

ドキュメント全体を調べて、## 形式の文字列を探します。探している項目は数字なので、常に ##014、##054 などになります。##... を含む文字列が見つかった場合は、マイ ドキュメント内の Excel ワークシート CodesNew.xls を検索する必要があります。列 A に一致する文字列が見つかった場合、Word ドキュメントの文字列を列 B の値に置き換える必要があります。値はマージフィールドとして入力する必要があります。

私が今持っているのは、Word 文書を検索して置き換えることだけです。

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
   .Text = "##*"
   .Replacement.Text = "KDKKD"
   .Forward = True
   .Format = False
   .MatchCase = False
   .MatchWholeWord = False
   .MatchWildcards = True
   .MatchSoundsLike = False
   .MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
4

1 に答える 1

1

あなたはこれを試すことができます。WOrdVBAエディターの[ツール]->[参照]からMicrosoftActiveXData Objectsライブラリへの参照を作成し、パス、ドキュメント、およびシート名を必要なものに修正し、独自のエラーチェックを追加する必要があります。実際に.xlsxを使用してコードを格納している場合は、OLEDBプロバイダー名を変更する必要があります。

Sub replaceWithNamesFromExcel()
' Alter this as needed
Const strMatch As String = "##[0-9]{1,}"
Dim bOpened As Boolean
Dim connXL As ADODB.Connection
Dim rsXL As ADODB.Recordset
Dim rng1 As Word.Range
Dim rng2 As Word.Range
Set connXL = New ADODB.Connection
With connXL
  ' Fix the path in here to be the one you need
  .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\mypath\test.xls;Extended Properties=""Excel 8.0;HDR=No;IMEX=1"";"""
  .Open
End With
Set rsXL = New ADODB.Recordset
Set rsXL.ActiveConnection = connXL
Set rng1 = ActiveDocument.Content
With rng1.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Text = strMatch
  .Forward = True
  .Format = False
  .MatchCase = False
  .MatchWholeWord = False
  .MatchWildcards = True
  .MatchSoundsLike = False
  .MatchAllWordForms = False
  While .Execute
    Set rng2 = rng1.Duplicate
    rsXL.Open "SELECT F2 FROM [CodeNew$] WHERE F1 = '" & rng2.Text & "'"
    If Not rsXL.EOF Then
      rng2.Fields.Add Range:=rng2, _
        Type:=WdFieldType.wdFieldEmpty, _
        Text:="MERGEFIELD """ & rsXL.Fields(0).Value & """", _
        preserveformatting:=False
    End If
    rsXL.Close
    Set rng2 = Nothing
  Wend
End With
Set rng1 = Nothing
Set rsXL = Nothing
connXL.Close
Set connXL = Nothing
End Sub

コメントを統合するために...

コメントで説明されているように、これに関するOPの問題は、おそらく.xlsファイルをc：\のすぐ下に配置することで発生すると考えられます。これにより、アクセス許可の問題が発生する可能性があります。ファイル。しかし、それを伝えるのは難しいです。

于 2012-08-15T16:31:30.337 に答える