Замените текст WORD для определенного значения ячейки в Excel, используя VBA

Question

Я новичок здесь, и я также новичок в VBA. Мне нужно заменить определенное значение ячейки в документе WORD. У меня есть заменяющая часть кода, но только для конкретного текста. Мне нужно заменить текст с определенными значениями ячеек, в определенных рабочих листах.

ячейка 1: рабочий лист "sheet3" C17;

ячейка 2: рабочий лист "sheet3" C18;

ячейка 3: рабочий лист "sheet3" C19;

Какие-нибудь мысли?

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

Новая функция FormatCellVal() проверяет типы ячеек (даты, проценты)

---

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 (Лист 3)

Слово Док - До:

Word Doc - после:

---

,

Найти ссылку - Критерии для операций поиска

---

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

Answer 2

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