|
* 楼上朋友,下面两段代码请参考(不是我编的,我也是抄网上的):
- Sub Excel2Word_for_Excel()
- '2021/4/10/test-ok
- Dim wdApp As Object, wkSht As Worksheet, p$, s$, i$, n&
- Set wdApp = CreateObject("Word.Application")
- p = MyLoopFolder
- s = Dir(p & "*.*")
- GoSub Xls
- Do While s > ""
- s = Dir
- GoSub Xls
- Loop
- wdApp.Application.Quit
- Set wdApp = Nothing
- Set wkSht = Nothing
- Exit Sub
- Xls:
- If s Like "*.xls*" Then
- i = p & s
- workbooks.Open FileName:=i
- s = Left(s, InStrRev(s, ".") - 1)
- For Each wkSht In ActiveWorkbook.Sheets
- wkSht.UsedRange.Copy
- With wdApp
- .Visible = True
- .Documents.Add
- .Selection.Paste
- n = n + 1
- .ActiveDocument.SaveAs FileName:=p & s & n & ".docx"
- .ActiveDocument.Close
- End With
- Next
- n = 0
- ActiveWorkbook.Close
- Kill i
- End If
- Return
- End Sub
- Sub Excel2Word()
- 'NoSubdir/2021/4/12/Test-OK/Excel2Word + TextMerge + TableMerge
- Dim xlApp As Object, xlWkb As Object, wkSht As Object, p$, s$, i$, n&
- Set xlApp = CreateObject("Excel.Application")
- p = MyLoopFolder
- s = Dir(p & "*.*")
- GoSub Xls
- Do While s > ""
- s = Dir
- GoSub Xls
- Loop
- xlApp.Application.Quit
- Set xlApp = Nothing
- Set xlWkb = Nothing
- Set wkSht = Nothing
- MsgBox "所有Excel表格已另存为Word表格!", 0 + 48
- Exit Sub
- Xls:
- If s Like "*.xls*" Then
- i = p & s
- s = Left(s, InStrRev(s, ".") - 1)
- Set xlWkb = xlApp.workbooks.Open(FileName:=i)
- For Each wkSht In xlWkb.Sheets
- wkSht.UsedRange.Copy
- Documents.Add
- Selection.Paste
- n = n + 1
- ActiveDocument.SaveAs FileName:=p & s & n & ".docx"
- ActiveDocument.Close
- Next
- n = 0
- xlWkb.Close
- Kill i
- End If
- Return
- End Sub
复制代码 |
|