krishnaoptif
Board Regular
- Joined
- Sep 17, 2010
- Messages
- 140
Hi Experts,
Pelase change my code... when i am storing excel cell value in variable and replaceing data in MS word with the same variable
then this code change "subSubscript and super script" data as normal text...
but i need same data in ms word like as in Excel cell with "sub and super script"...
Please update my below code which is developed in MS word...
Please help
Pelase change my code... when i am storing excel cell value in variable and replaceing data in MS word with the same variable
then this code change "subSubscript and super script" data as normal text...
but i need same data in ms word like as in Excel cell with "sub and super script"...
Please update my below code which is developed in MS word...
Please help
Code:
Sub ReplaceExcelCellvalueInMswordFile()
Dim wdApp As Word.Application
Dim wdDoc As Word.Document
Dim SrcWb As Workbook
Dim SrcWs As Worksheet
Dim arrCnt As Integer
Dim LastCol As Long
Dim LastRow As Long
Dim NxtRow As Long
Dim arrFiles As Variant
Dim FName As String
Dim FilesPath As Variant
Dim r, RR, RRR, R4, c, RecordCount, RecordCount_2, NewRecord, P, BreakLoop, OneRecordFill As Integer
Dim Sum_AMT, Count_GL, Count_MISGrouping As Double
Dim MISgroupName As Variant
Dim str, str2, str3, str4 As String
Dim iCount As Long
Dim strSearch1, strSearch2, strReplace As String
Const YOUR_REQUIRED_COLOR_IDX As Integer = 6 'RED'
Dim doc As Range
Set doc = ActiveDocument.Range
'File picker
Dim dlg As Variant
Dim dataPath As Variant
Set dlg = Application.FileDialog(msoFileDialogFilePicker)
dlg.Title = "Select your MS word File for replace the word"
dlg.AllowMultiSelect = False
If dlg.Show = -1 Then
dataPath = dlg.SelectedItems(1)
'Me!browseDataPath.Value = dataPath
End If
Set SrcWb = Workbooks.Open(dataPath, False, True)
Set SrcWs = SrcWb.Sheets("DATA")
With SrcWs
'Count the word
r = 2
str = SrcWs.Cells(r, 1).Value
While str <> ""
strSearch1 = SrcWs.Cells(r, 1).Value
strSearch2 = SrcWs.Cells(r, 2).Value & " (" & SrcWs.Cells(r, 2).Value & ")"
strReplace = SrcWs.Cells(r, 2).Value
iCount = 0
Application.Options.DefaultHighlightColorIndex = wdRed
With ThisDocument.Content.Find
.Text = strSearch1
.Replacement.Text = strReplace
.Replacement.Highlight = True
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
Application.Options.DefaultHighlightColorIndex = wdRed
With ThisDocument.Content.Find
.Text = strSearch2
.Replacement.Text = strReplace
.Replacement.Highlight = True
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
iCount = 0
'Count the word and color
With ThisDocument.Content.Find
.Text = strReplace
.Highlight = True
.Wrap = wdFindStop
Do While .Execute
iCount = iCount + 1
Loop
End With
If iCount > 1 Then
Application.Options.DefaultHighlightColorIndex = wdYellow
With ThisDocument.Content.Find
.Text = strReplace
.Replacement.Text = strReplace
.Highlight = True
.Replacement.Highlight = True
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
End If
r = r + 1
str = SrcWs.Cells(r, 1).Value
Wend
SrcWb.Close False
End With
Set SrcWs = Nothing
Set SrcWb = Nothing
MsgBox "Done"
End Sub
Last edited: