Transfer excel info to a word document

dave73101

New Member
Joined
Sep 5, 2002
Messages
2
I'm transferring information from an excel spreadsheet to a word document by clicking a command button in excel that uses visual basic code to open the word document, then searching and replacing text, e.g., find "$Address" and replace it with the contents of C7. However, I am having a problem with inserting a table by finding "$Table" in the word document and replacing it with a table, e.g., 3 columns and 5 rows.

Can anybody point me to an example?

Thanks.
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand

XL-Dennis

Well-known Member
Joined
Jul 27, 2002
Messages
1,920
Dave,

Welcome to the board :)

However, I am having a problem with inserting a table by finding "$Table" in the word document and replacing it with a table, e.g., 3 columns and 5 rows.

Could You provide us with the present VBA-code. This may be more convenient for You instead of receving a total new solution :)

Kind regards,
Dennis
 

dave73101

New Member
Joined
Sep 5, 2002
Messages
2
Here it is:

Private Sub CommandButton2_Click()
'This drafts the permit when the "Draft Permit" button is pushed.
On Error GoTo errorHandler
Dim wdApp As Word.Application
Dim myDoc As Word.Document
Dim mywdRange As Word.Range
Dim sText As String, lText As String, LineSpace As Integer, LastName As String
Dim sCompleteness As String, sFileName As String
'Dim myRange As Word.Range

Set wdApp = New Word.Application
With wdApp
.Visible = True
.WindowState = wdWindowStateMaximize
Set wdDoc = wdApp.Documents.Open("C:New Facility Construction Permit Format.doc")
End With

'For a construction permit, update (search & replace) the standard format w/site specific information
Dim sFindText As String
Dim sReplacementText As String
Dim i As Integer

‘This does not work
With ActiveWindow
Selection.Find.ClearFormatting
With Selection.Find
.Text = "$Table1"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.ConvertToTable Separator:=wdSeparateByParagraphs, NumColumns:=1, _
NumRows:=1, Format:=wdTableFormatNone, ApplyBorders:=True, ApplyShading _
:=True, ApplyFont:=True, ApplyColor:=True, ApplyHeadingRows:=True, _
ApplyLastRow:=False, ApplyFirstColumn:=True, ApplyLastColumn:=False, _
AutoFit:=True, AutoFitBehavior:=wdAutoFitFixed
End With


For i = 1 To 17
Select Case i
Case 1
sFindText = "$CurrentDate"
sReplacementText = Worksheets("Sheet12").Range("C39")
Case 2
sFindText = "$ChiefEngineer"
sReplacementText = Worksheets("Sheet12").Range("A60")
Case 3
sFindText = "$Reviewer1"
sReplacementText = Worksheets("Sheet12").Range("A61")
Case 4
sFindText = "$Reviewer2"
sReplacementText = Worksheets("Sheet12").Range("A62")
Case 5
sFindText = "$PermitDrafter"
sReplacementText = Worksheets("Sheet12").Range("C42")
Case 6
sFindText = "$PermitNumber"
sReplacementText = Worksheets("Sheet12").Range("C41")
Case 7
sFindText = "$CompanyName"
sReplacementText = Worksheets("Sheet12").Range("D23")
Case 8
sFindText = "$FacilityName"
sReplacementText = Worksheets("Sheet1").Range("C8")
Case 9
sFindText = "$Location"
sReplacementText = "Section " & Worksheets("Sheet1").Range("C11") & ", T" & Worksheets("Sheet1").Range("F11") & ", R" & Worksheets("Sheet1").Range("C11")
Case 10
sFindText = "$Directions"
sReplacementText = Worksheets("Sheet1").Range("C12")
Case 11
sFindText = "$SicCode"
sReplacementText = Worksheets("Sheet1").Range("C16")
Case 12
sFindText = "$PermitType"
sReplacementText = Worksheets("Sheet1").Range("C19")
Case 13
sFindText = "$ContactName"
sReplacementText = Worksheets("Sheet12").Range("D24")
Case 14
sFindText = "$ContactAddress"
If Len(Worksheets("Sheet12").Range("D27")) = 0 Then
sReplacementText = Worksheets("Sheet12").Range("D25")
Else
sReplacementText = Worksheets("Sheet12").Range("D25") & vbCrLf & Worksheets("Sheet1").Range("D26")
End If
Case 15
sFindText = "$CityStateZip"
If Len(Worksheets("Sheet12").Range("D27")) = 0 Then
sReplacementText = Worksheets("Sheet12").Range("D26")
Else
sReplacementText = Worksheets("Sheet12").Range("D27")
End If
Case 16
sFindText = "$Salutation"
If Worksheets("Sheet12").Range("E27") = 1 Then sReplacementText = "Mr."
If Worksheets("Sheet12").Range("E27") = 2 Then sReplacementText = "Mrs."
If Worksheets("Sheet12").Range("E27") = 3 Then sReplacementText = "Ms."
Case 17
sFindText = "$ContactLastName"
LineSpace = Len(Worksheets("Sheet12").Range("D24")) - InStrRev(Worksheets("Sheet12").Range("D24"), " ")
sReplacementText = Right$(Worksheets("Sheet12").Range("D24"), LineSpace)
End Select

'THIS WORKS only if page setup is new page break w/first page different and all headers/footers are "same as previous."
For Each myStoryRange In ActiveDocument.StoryRanges
myStoryRange.Find.Execute FindText:=sFindText, Forward:=True
myStoryRange.Find.Replacement.Text = sReplacementText
While myStoryRange.Find.Found
' myStoryRange.Bold = True
myStoryRange.Find.Execute _
FindText:=sFindText, Forward:=True
myStoryRange.Find.Execute _
Replace:=wdReplaceAll
Wend
While Not (myStoryRange.NextStoryRange Is Nothing)
Set myStoryRange = myStoryRange.NextStoryRange
myStoryRange.Find.Execute FindText:=sFindText, Forward:=True
While myStoryRange.Find.Found
' myStoryRange.Bold = True
myStoryRange.Find.Execute _
FindText:=sFindText, Forward:=True
myStoryRange.Find.Execute _
Replace:=wdReplaceAll
Wend
Wend
Next myStoryRange

Next i

errorHandler:
Set wdApp = Nothing
Set myDoc = Nothing
Set mywdRange = Nothing
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,129,816
Messages
5,638,496
Members
417,029
Latest member
lingx86

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top