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 3: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

<pre>
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) &gt; "" And xlApp.Range(myCell2) &gt; "" And xlApp.Range(myCell3) &gt; ""

'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)

  Print Answers RSS
0 OriginalGriff 490
1 Sergey Alexandrovich Kryukov 335
2 ProgramFOX 265
3 Maciej Los 245
4 Andreas Gieriet 200
0 OriginalGriff 465
1 Sergey Alexandrovich Kryukov 275
2 ProgramFOX 265
3 Maciej Los 245
4 Andreas Gieriet 200


Advertise | Privacy | Mobile
Web04 | 2.8.150331.1 | Last Updated 21 Feb 2013
Copyright © CodeProject, 1999-2015
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