Question

利用VBA实现WORD特定位置中录入EXCEL中数字，用的WPS

利用VBA实现WORD特定位置中录入EXCEL中某些数字,比如有WORD文件路径“F:\编程学习\3月\3.doc”，EXCEL文件同路径“F:\编程学习\3月\2016年3月.xls”，需要将EXCEL中的B3和C3数字，替换WORD中的“该月有AA例和BB例”中的AA和BB。求高手。我用的WPS专业版。万分感谢

Answer 1

只会用excel，wps没用过。
这vba要根据需求来定的。下面这个例子供参考。
Option Explicit
Sub ｶﾁﾈ｡ﾐﾅﾏ｢(MYFILE As String, MYROW As Integer)
Dim myS As String
Dim wdApp, wdDocument
Dim wdTable
Dim i, j, k, L, M As Integer
Dim myArr(1 To 10000) As String
Dim dArr(1 To 10, 1 To 3)
Dim ii As Integer
'myfile = Cells(2, 4)
'myfile = ThisWorkbook.Path & "\" & myfile & ".docx"

'Set wdApp = GetObject(, "word.Application") 'ﾈ｡ｵﾃﾄｿﾇｰｴｪｵﾄwordﾓｦﾓﾃ
'wdApp.Quit
100 Set wdApp = CreateObject("word.application") 'ｴｴｽｨﾒｻｸordﾓｦﾓﾃ

Dim ocell
k = 1
Set wdDocument = wdApp.Documents.Open(MYFILE)
wdDocument.Select
i = wdDocument.Tables.Count
Dim mysArr
For j = 1 To i
Set wdTable = wdDocument.Tables(j)
'For Each ocell In ActiveDocument.Tables(J).Range.Cells 'ﾗ｢ﾒ磴ellsﾇｰﾓﾐｸange
For Each ocell In wdTable.Range.Cells 'ﾗ｢ﾒ磴ellsﾇｰﾓﾐｸange
' MsgBox ocell.Range.Text
myS = ocell.Range.Text
'mysArr = Split(myS, vbCrLf)
mysArr = Split(myS, Chr(7))
'If Right(myS, 1) = Chr(13) Then
'Do While Right(myS, 1) = Chr(7) Or Right(myS, 1) = Chr(32) Or Right(myS, 1) = Chr(13)
' myS = Mid(myS, 1, Len(myS) - 1)
'Loop
'End If
For ii = 0 To UBound(mysArr)
If Trim(mysArr(ii)) <> "" And Trim(mysArr(ii)) <> Chr(13) Then
'ﾈ･ｳﾓﾒｲ狃ﾘｳｵｷ釞ｰｿﾕｸ・
If Right(mysArr(ii), 1) = Chr(13) Then
Do While Right(mysArr(ii), 1) = Chr(7) Or Right(mysArr(ii), 1) = Chr(32) Or Right(mysArr(ii), 1) = Chr(13)
mysArr(ii) = Mid(mysArr(ii), 1, Len(mysArr(ii)) - 1)
Loop
End If

myArr(k) = Trim(mysArr(ii))
k = k + 1
End If
Next ii

'myArr(k) = myS
'k = k + 1
Next ocell

Next j
wdApp.Quit
k = k - 1 'kｼﾇﾂｼwordﾎﾄｵｵｵﾄﾊｾﾝｸ
Sheets("sheet3").Select
For i = 1 To k
Cells(i, 1) = i
Cells(i, 2) = myArr(i)
Next i

Sheets("tools").Select
i = 2
Do While Cells(i, 7) <> ""

dArr(i - 1, 1) = Cells(i, 7)
dArr(i - 1, 2) = Cells(i, 8)
dArr(i - 1, 3) = Cells(i, 9)

i = i + 1
Loop
i = i - 2 'Iｼﾇﾂｼｶﾁﾈ｡ｶﾔﾏﾄｸ
Dim tArr
For j = 1 To i
ReDim tArr(1 To dArr(j, 3))
'ｲ鲽ﾒｹﾘｼ・ﾖ

For L = 1 To k
If dArr(j, 1) = myArr(L) Then
Exit For
End If
Next L 'Lｼﾇﾂｼｲ鲂ｽｵｽｹﾘｼ・ﾖｵﾄﾎｻﾖﾃ
L = L + dArr(j, 2) + dArr(j, 3) 'ﾎｻﾖﾃｵ訒ｬﾕﾒｵｽｵﾚﾒｻｸｾﾝｵﾄﾎｻﾖﾃ
For M = 1 To dArr(j, 3)
tArr(M) = myArr(L + M - 1)
Next M
'ｽｫｲ鲽ﾒｵﾄﾊﾖｵﾐｴﾈ・ｸｶｨﾎｻﾖﾃ
Select Case j
Case 1
Sheets("ｸﾋｼｰﾅ菁ｼﾉ昞ﾝｾﾓﾗ｡ﾐﾅﾏ｢ﾀ・).Select
Cells(MYROW, 2) = tArr(1)
Cells(MYROW, 3) = tArr(2)
Cells(MYROW, 4) = tArr(3)
Sheets("ｹ､ﾗﾅﾏ｢ﾀ・).Select
Cells(MYROW, 2) = tArr(1)
Cells(MYROW, 3) = tArr(2)

Case 2
Sheets("ｸﾋｼｰﾅ菁ｼﾉ昞ﾝｾﾓﾗ｡ﾐﾅﾏ｢ﾀ・).Select
Cells(MYROW, 5) = tArr(1)
Cells(MYROW, 6) = tArr(2)
Cells(MYROW, 7) = tArr(3)
Cells(MYROW, 8) = tArr(4)
Cells(MYROW, 10) = tArr(6)
Cells(MYROW, 12) = tArr(7)
Cells(MYROW, 13) = tArr(8)
Sheets("ｹ､ﾗﾅﾏ｢ﾀ・).Select
Cells(MYROW, 6) = tArr(5)
Case 3

Case 4
Sheets("ｸﾋｼｰﾅ菁ｼﾉ昞ﾝｾﾓﾗ｡ﾐﾅﾏ｢ﾀ・).Select
Cells(MYROW, 11) = tArr(2)

Case 5
Sheets("ｹ､ﾗﾅﾏ｢ﾀ・).Select
Cells(MYROW, 4) = tArr(2)
Cells(MYROW, 5) = tArr(3)
Case 6
Sheets("ｹ､ﾗﾅﾏ｢ﾀ・).Select
Cells(MYROW, 7) = tArr(2)
Cells(MYROW, 8) = tArr(3)
Cells(MYROW, 9) = tArr(4)
Cells(MYROW, 10) = tArr(5)
Cells(MYROW, 11) = tArr(6)

End Select
Next j

End Sub