Click here to Skip to main content
Rate this: bad
good
Please Sign up or sign in to vote.
See more: VBA Word
Is there an easy(-ish) way of doing the following :
 
1. Highlight some text in a Word document
2. Press a (custom) button
3a. Read data from a specific cell in an Excel sheet (the Excel file always has the same name, the Row is defined by the numeric characters of the Word document) and replace the highlighted data.
3b. Alternatively, rather than highlighting text in the Word document, it has unique text.
 
For example, I have a document open called WordDoc6.
 
There is text in there that says "Replace this text" (which can be highlighted)
 
I press a button & it runs a program that opens MyExcelFile & reads the data in Column 2, Row 6 ... then replaces "Replace this text" with that data ...
Posted 18-Jan-13 2:20am

1 solution

Rate this: bad
good
Please Sign up or sign in to vote.

Solution 1

OK, as nobody here knows how to do this, here is a way of doing it in case anybody else is looking for a similar solution ... hope it helps ...
 
'Create a link to use Excel

    If Tasks.Exists(Name:="Microsoft Excel") = False Then
        Set xlApp = CreateObject("Excel.Application")
    ElseIf Tasks.Exists(Name:="Microsoft Excel") = True Then
        Set xlApp = GetObject(, "Excel.Application")
    End If
 
'Ensure Excel is Visible & not Hidden
    
    xlApp.Application.Visible = True
 
'Open the Excel File that you want to edit
    xlApp.Workbooks.Open myFolderPath + "Manager Of The Month.xlsx"
    
'Define specific Cells in the Excel file & Select the first one

    Dim myCell1 as String
    Dim myCell2 as String
    Dim myCell3 as String
 
    myCell1 = "B" & mySession + 1
    myCell2 = "C" & mySession + 1
    myCell3 = "D" & mySession + 1
    
    xlApp.Range(myCell1).Select
    
'Wait until the Cells you want filled in the Excel file have all been filled

    Do
        'nothing
    Loop Until xlApp.Range(myCell1) > "" And xlApp.Range(myCell2) > "" And xlApp.Range(myCell3) > ""
    
'Replace the text "MOTMDIV1" with the data entered into the first Excel Cell

    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "MOTMDIV1"
        .Replacement.Text = xlApp.Range(myCell1).Value
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
 
'Complete the edit update in the Word document by actually making the change

    Selection.Find.Execute Replace:=wdReplaceAll
 
'Replace the text "MOTMDIV2" with the data entered into the second Excel Cell

    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "MOTMDIV2"
        .Replacement.Text = xlApp.Range(myCell2).Value
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
 
'Complete the edit update in the Word document by actually making the change

    Selection.Find.Execute Replace:=wdReplaceAll
 
'Replace the text "MOTMDIV3" with the data entered into the third Excel Cell

    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "MOTMDIV3"
        .Replacement.Text = xlApp.Range(myCell3).Value
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
 
'Complete the edit update in the Word document by actually making the change

    Selection.Find.Execute Replace:=wdReplaceAll
 
'Save & Quit Excel

    xlApp.ActiveWorkbook.Save
    xlApp.Quit
    
    Set xlApp = Nothing
 
This can probably be improved upon in many ways, including using a loop if you have a lot of Cells, but it's working for me and as it is a personal program I am happy with it.
  Permalink  

This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)



Advertise | Privacy | Mobile
Web03 | 2.8.140926.1 | Last Updated 21 Feb 2013
Copyright © CodeProject, 1999-2014
All Rights Reserved. Terms of Service
Layout: fixed | fluid

CodeProject, 503-250 Ferrand Drive Toronto Ontario, M3C 3G8 Canada +1 416-849-8900 x 100