Remplacer le texte WORD par la valeur d'une cellule spécifique dans Excel en utilisant VBA

La nouvelle fonction FormatCellVal() contrôle des types de cellules (dates, pourcentages)

Option Explicit

Private Sub CommandButton1_Click()
    Dim wdApp As Word.Application, wdDoc As Word.Document, i As Long, txt As String
    Dim ws As Worksheet, fromTxt As Variant, intoTxt As Variant, lr As Long

    Set ws = ThisWorkbook.Worksheets("Sheet3")
    lr = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
    Set wdApp = New Word.Application
    On Error Resume Next    'Expected errors: Word file not found, or open
    Set wdDoc = wdApp.Documents.Open("C:\Test.docx")
    wdApp.Visible = True
    wdApp.Activate

    '-------------------------------------------------------------------------------------
    fromTxt = ws.Range("C1:C" & lr)
    intoTxt = ws.Range("B1:B" & lr)
    '-------------------------------------------------------------------------------------

    With wdDoc.Content.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        For i = LBound(fromTxt) To UBound(fromTxt)
            If Not IsError(fromTxt(i, 1)) And Not IsError(intoTxt(i, 1)) Then
                 txt = FormatCellVal(fromTxt(i, 1), ws.Cells(i, "C").NumberFormatLocal)
                .Text = txt
                 txt = FormatCellVal(intoTxt(i, 1), ws.Cells(i, "B").NumberFormatLocal)
                .Replacement.Text = txt
                .MatchWholeWord = True
                .Execute Replace:=2     'wdReplaceAll   (WdReplace  Enumeration)
            End If
        Next
    End With
    wdApp.Quit SaveChanges:=True
End Sub

Private Function FormatCellVal(ByVal cVal As Variant, ByVal cFormat As String) As String
    Select Case True
        Case InStr(1, cFormat, "%") > 0: FormatCellVal = cVal * 100 & "%"
        Case IsDate(cVal):               FormatCellVal = Format(cVal, cFormat)
        Case Else:                       FormatCellVal = cVal
    End Select
End Function

.

Excel (Sheet3)

Word Doc - Avant :

Word Doc - Après :

.

Trouvez Référence - Critères pour les opérations de recherche

Methods

Name                 Description
'-----------------------------------------------------------------------------------------
ClearAllFuzzyOptions Clears all nonspecific search options for Japanese text
ClearFormatting      Removes text and paragraph formatting from the text
ClearHitHighlight    Removes highlighting for all text. Boolean (Successful/Not)
Execute              Runs the find operation. Boolean (Successful/Not)
Execute2007          Runs the find operation. Boolean (Successful/Not)
HitHighlight         Highlights all found matches. Boolean (Successful/Not)
SetAllFuzzyOptions   Activates all nonspecific search options for Japanese text

Properties - 1 of 2

Name                 Description
'-----------------------------------------------------------------------------------------
Application          Returns an Application object that represents the Ms Word app
CorrectHangulEndings Read/Write Boolean - True if it corrects Hangul endings
Creator              Read-only Long - Returns 32-bit int - indicates app of the object
Font                 Read/Write Font - Returns or sets a Font object (char formatting)
Format               Read/Write Boolean - True if formatting is included
Forward              Read/Write Boolean - True if the find operation searches forward
Found                Read-only Boolean - True if the search produces a match
Frame                Read-only - formatting for specified style or find/replace
HanjaPhoneticHangul  Read/Write Boolean - locate phonetic Hangul & hanja chars inKorean
Highlight            Read/Write Long - True if highlight formatting included in criteria
IgnorePunct          Read/Write Boolean - ignore punctuation in found text
IgnoreSpace          Read/Write Boolean - ignore extra white space in found text
LanguageID           Read/Write WdLanguageID - Returns or sets the language
LanguageIDFarEast    Read/Write WdLanguageID - Returns or sets an East Asian language
LanguageIDOther      Read/Write WdLanguageID - Returns or sets the language
MatchAlefHamza       Read/Write Boolean - True if find match txt with alef hamzas Arabic
MatchAllWordForms    Read/Write Boolean - True for all forms ("sit," "sat" and "sitting")
MatchByte            Read/Write Boolean - True if distinguishes full or half-width ltrs
MatchCase            Read/Write Boolean - True if it is case sensitive. Default is False
MatchControl         Read/Write Boolean - True for right-to-left lang
MatchDiacritics      Read/Write Boolean - True for right-to-left lang
MatchFuzzy           Read/Write Boolean - True if uses nonspecific options for Japanese
MatchKashida         Read/Write Boolean - True for matching kashidas in an Arabic
MatchPhrase          Read/Write Boolean - True ignores white sp/ctrl chars between words
MatchPrefix          Read/Write Boolean - True to match words beginning with search str
MatchSoundsLike      Read/Write Boolean - True to return words that sound similar
MatchSuffix          Read/Write Boolean - True to match words ending with search str
MatchWholeWord       Read/Write Boolean - True to locate only entire words
MatchWildcards       Read/Write Boolean - True if the text to find contains wildcards

.

Properties - 2 of 2

Name                 Description
'-----------------------------------------------------------------------------------------
NoProofing           Read/Write Long - True to find/replace txt ignored by spell & grammar
ParagraphFormat      Returns or sets a ParagraphFormat object (settings). Read/write
Parent               Returns parent object of the specified Find object
Replacement          Returns Replacement object that contains criteria for replace op
Style                Read/Write Variant - Returns or sets style for the specified object
Text                 Read/Write String - Returns or sets the text to find
Wrap                 Read/write WdFindWrap - wrapping if start point other than doc start

Private Sub CommandButton1_Click()

Dim pathh As String
Dim pathhi As String
Dim oCell  As Integer
Dim from_text As String, to_text As String
Dim WA As Object

pathh = "C:\test.docx"

Set WA = CreateObject("Word.Application")
WA.Documents.Open (pathh)
WA.Visible = True

For oCell = 1 To 300
    from_text = Folha7.Range("C" & oCell).Value
    to_text = Folha7.Range("B" & oCell).Value
    With WA
        .Activate
        With .Selection.Find
          .ClearFormatting
          .Replacement.ClearFormatting

          .Text = from_text
          .Replacement.Text = to_text
          .Execute Replace:=wdReplaceAll
        End With
    End With
Next

End Sub