如何用VBA 向word中导入excel中的数据
3个回答
展开全部
'代码已经测试过,请注意保持良好习惯,及时采纳,谢谢。
Sub PasteToWordDoc()
'
' 需要引用MIcrosoft Word 12.0 Object Library(注:12.0是版本号,可以不同)
'
Application.ScreenUpdating = False '关闭屏幕刷新'
Selection.Copy
Dim wdApp As Word.Application, wdDoc As Word.Document
Dim strDocPath As String '全路径文件名
Dim blnNoWd As Boolean, blnNoWdd As Boolean
On Error Resume Next
strDocPath = "C:\Users\wine\Desktop\可ihikhoi年.docm" '如果与Excel工作薄同路径,采用这面的语句也可
'strDocPath = ThisWorkbook.Path & "\可ihikhoi年.docm"
'调用word程序对象
Set wdApp = GetObject(, "Word.Application") '实例化word对象变量
If wdApp Is Nothing Then '判断word程序是否正在运行
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = False
blnNoWd = True
End If
'调用word 文档对象
Set wdDoc = wdApp.Documents(strDocPath)
If wdDoc Is Nothing Then
Set wdDoc = wdApp.Documents.Open(Filename:=strDocPath, Visible:=flase)
blnNoWdd = True
Else
wdDoc.Activate
End If
wdApp.Selection.PasteExcelTable False, False, False
wdDoc.Save
'恢复环境
If blnNoWdd Then wdDoc.Close: Set wdDoc = Nothing
If blnNoWd Then wdApp.Quit: Set wdApp = Nothing
Application.ScreenUpdating = True
On Error GoTo 0
End Sub
Sub PasteToWordDoc()
'
' 需要引用MIcrosoft Word 12.0 Object Library(注:12.0是版本号,可以不同)
'
Application.ScreenUpdating = False '关闭屏幕刷新'
Selection.Copy
Dim wdApp As Word.Application, wdDoc As Word.Document
Dim strDocPath As String '全路径文件名
Dim blnNoWd As Boolean, blnNoWdd As Boolean
On Error Resume Next
strDocPath = "C:\Users\wine\Desktop\可ihikhoi年.docm" '如果与Excel工作薄同路径,采用这面的语句也可
'strDocPath = ThisWorkbook.Path & "\可ihikhoi年.docm"
'调用word程序对象
Set wdApp = GetObject(, "Word.Application") '实例化word对象变量
If wdApp Is Nothing Then '判断word程序是否正在运行
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = False
blnNoWd = True
End If
'调用word 文档对象
Set wdDoc = wdApp.Documents(strDocPath)
If wdDoc Is Nothing Then
Set wdDoc = wdApp.Documents.Open(Filename:=strDocPath, Visible:=flase)
blnNoWdd = True
Else
wdDoc.Activate
End If
wdApp.Selection.PasteExcelTable False, False, False
wdDoc.Save
'恢复环境
If blnNoWdd Then wdDoc.Close: Set wdDoc = Nothing
If blnNoWd Then wdApp.Quit: Set wdApp = Nothing
Application.ScreenUpdating = True
On Error GoTo 0
End Sub
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询