ä¸é¢è¿æ®µä»£ç æ¯å®ç°å°excelè¡¨æ ¼æå
¥å°æå®word模æ¿çæå®ä½ç½®ãå¯ä»¥åèä¸ä¸ã
Sub æå
¥è¡¨æ ¼()
Dim SS As String
Dim wdoc As New Word.Application
Dim å½åè·¯å¾, 导åºè·¯å¾æ件å, i, j
Dim Str1, Str2, Str3
Dim tarr(1 To 100, 1 To 3)
Dim filepathname As String
å½åè·¯å¾ = ThisWorkbook.Path
æåè¡å· = Sheets("æ°åè¡¨æ ¼").Range("B30").End(xlUp).Row
å¤æ = 0
' 导åºæ件å = "æ¥åä½å.doc"
filepathname = å½åè·¯å¾ & "\" & Tfile
If Dir(filepathname) = "" Then
'æ件ä¸åå¨
FileCopy å½åè·¯å¾ & "\" & Sfile, å½åè·¯å¾ & "\" & Tfile
End If
Sheets("æ°åè¡¨æ ¼").Select
For i = KShh To æåè¡å·
tarr(i - KShh + 1, 1) = Sheets("æ°åè¡¨æ ¼").Cells(i, 1)
tarr(i - KShh + 1, 2) = Sheets("æ°åè¡¨æ ¼").Cells(i, 2)
tarr(i - KShh + 1, 3) = Sheets("æ°åè¡¨æ ¼").Cells(i, 3)
Next i
j = i - KShh 'è®°å½éæ¿æ¢ææ¬ä¸ªæ°
导åºè·¯å¾æ件å = å½åè·¯å¾ & "\" & Tfile
With wdoc 'æå¼wordææ¡£
.Documents.Open 导åºè·¯å¾æ件å
.Visible = True
End With
For i = 1 To j
Str1 = tarr(i, 1)
Str2 = tarr(i, 2)
Str3 = tarr(i, 3)
Range(Str3).Select
Application.CutCopyMode = False
Selection.Copy
With wdoc
.Selection.HomeKey Unit:=wdStory 'å
æ ç½®äºæ件é¦
If .Selection.Find.Execute(Str1) Then 'æ¥æ¾å°æå®å符串
.Selection.Text = "" 'æ¿æ¢å符串
.Selection.PasteExcelTable False, False, False 'ç²è´´ä¸ºè¡¨æ ¼
.Selection.WholeStory
.Selection.Font.Size = 12
With .Options
.DefaultBorderLineStyle = wdLineStyleSingle
.DefaultBorderLineWidth = wdLineWidth050pt
.DefaultBorderColor = wdColorAutomatic
End With
.Selection.Tables(1).PreferredWidthType = 3
.Selection.Tables(1).PreferredWidth = .CentimetersToPoints(15)
End If
' wdoc.Documents.Save
' wdoc.Quit
' Set wdoc = Nothing
End With
Next i
With wdoc 'åçåå
³éWORDææ¡£
wdoc.Documents.Save
wdoc.Quit
Set wdoc = Nothing
End With
Sheets("é¦é¡µ").Select
End Sub
温馨提示:答案为网友推荐,仅供参考