Substituir o texto do WORD por um valor de célula específico no Excel usando o VBA

Question

Eu sou novo aqui e também sou novo no VBA. Eu preciso substituir um valor de célula específico em um documento do Word. Eu tenho a parte de substituição do código feita, mas apenas para um texto específico. Preciso substituir o texto por valores de célula específicos , em planilhas específicas .

célula 1: planilha "folha3" C17;

célula 2: planilha "folha3" C18;

célula 3: planilha "folha3" C19;

Alguma opinião?

Private Sub CommandButton1_Click()


Dim wdApp As word.Application
Dim wdDoc As word.Document
Dim wdRng As word.Range

Set wdApp = CreateObject("word.application")
wdApp.Visible = True
Set wdDoc = wdApp.Documents.Open("path...")
For Each wdRng In wdDoc.StoryRanges

With wdRng.Find
.Text = "#media1"
.Replacement.Text = "TEST" (REPLACE HERE WITH CELL C19)
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll

.Text = "#media2m"
.Replacement.Text = "TEST" (REPLACE HERE WITH CELL C17)
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll

.Text = "#media3m"
.Replacement.Text = "TEST" (REPLACE HERE WITH CELL C18)
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll

End With

Set wdApp = Nothing: Set wdDoc = Nothing: Set wdRng = Nothing

Next wdRng

End Sub

    

Answer 1

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

    

Answer 2

A nova função FormatCellVal() verifica os tipos de células (datas, porcentagens)

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 (Folha3)

WordDoc-Antes:

WordDoc-Depois:

.

FindReference-Criteriaforfindoperations

MethodsNameDescription'-----------------------------------------------------------------------------------------ClearAllFuzzyOptionsClearsallnonspecificsearchoptionsforJapanesetextClearFormattingRemovestextandparagraphformattingfromthetextClearHitHighlightRemoveshighlightingforalltext.Boolean(Successful/Not)ExecuteRunsthefindoperation.Boolean(Successful/Not)Execute2007Runsthefindoperation.Boolean(Successful/Not)HitHighlightHighlightsallfoundmatches.Boolean(Successful/Not)SetAllFuzzyOptionsActivatesallnonspecificsearchoptionsforJapanesetext

Properties-1of2NameDescription'-----------------------------------------------------------------------------------------ApplicationReturnsanApplicationobjectthatrepresentstheMsWordappCorrectHangulEndingsRead/WriteBoolean-TrueifitcorrectsHangulendingsCreatorRead-onlyLong-Returns32-bitint-indicatesappoftheobjectFontRead/WriteFont-ReturnsorsetsaFontobject(charformatting)FormatRead/WriteBoolean-TrueifformattingisincludedForwardRead/WriteBoolean-TrueifthefindoperationsearchesforwardFoundRead-onlyBoolean-TrueifthesearchproducesamatchFrameRead-only-formattingforspecifiedstyleorfind/replaceHanjaPhoneticHangulRead/WriteBoolean-locatephoneticHangul&hanjacharsinKoreanHighlightRead/WriteLong-TrueifhighlightformattingincludedincriteriaIgnorePunctRead/WriteBoolean-ignorepunctuationinfoundtextIgnoreSpaceRead/WriteBoolean-ignoreextrawhitespaceinfoundtextLanguageIDRead/WriteWdLanguageID-ReturnsorsetsthelanguageLanguageIDFarEastRead/WriteWdLanguageID-ReturnsorsetsanEastAsianlanguageLanguageIDOtherRead/WriteWdLanguageID-ReturnsorsetsthelanguageMatchAlefHamzaRead/WriteBoolean-TrueiffindmatchtxtwithalefhamzasArabicMatchAllWordFormsRead/WriteBoolean-Trueforallforms("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