|
- Sub Demo()
- Dim i As Long, j As Long
- Dim arrData, rngData As Range
- Dim arrRes, iR As Long, sDoc As String
- Dim RowCnt As Long, ColCnt As Long
- Set rngData = ActiveSheet.Range("A1").CurrentRegion
- arrData = rngData.Value
- RowCnt = UBound(arrData)
- ColCnt = UBound(arrData, 2)
- Dim wdApp As Object, wdDoc, wdTab
- On Error Resume Next
- Set wdApp = GetObject(, "word.application")
- On Error GoTo 0
- If wdApp Is Nothing Then
- Set wdApp = CreateObject("word.application")
- ' wdApp.Visible = True
- End If
- Set wdDoc = wdApp.Documents.Add
- Set wdTab = wdDoc.Tables.Add(Range:=wdApp.Selection.Range, _
- NumRows:=RowCnt, NumColumns:=ColCnt, DefaultTableBehavior:=1)
- For i = LBound(arrData) To UBound(arrData)
- For j = LBound(arrData, 2) To UBound(arrData, 2)
- wdTab.Cell(i, j).Range.Text = arrData(i, j)
- Next j
- Next i
- sDoc = ThisWorkbook.Path & "\WdTable.docx"
- Kill sDoc
- wdDoc.SaveAs sDoc
- wdDoc.Close
- ' wdApp.Quit
- MsgBox "Done"
- End Sub
复制代码 |
|