将数据从 Excel 文件复制到打开的 Word 文件

Question

希望我没有看到类似的问题。

我使用下面的代码将数据从一个 excel 文件复制到一个特定的 word 文件。这没有任何大问题。

我唯一想改进的是必须关闭 word 文件这一事实。

有没有办法使用这种方法将数据传递到打开的 word 文件？

Public Function Export()
Dim appWord As Object
Dim wdDoc As Object
.
.
.
Set appWord = CreateObject("Word.Application") 
Set wdDoc = appWord.Documents.Open(wrdfile)
With wdDoc
.Bookmarks("Mark1").Range.Text = ActiveSheet.Range("X24").Value
.Bookmarks("Mark2").Range.Text = ActiveSheet.Range("H23").Value
.
.
.
End with
End function

已尝试 Documents.Add(...) 但这只会打开 word 文件的一个新实例。

感谢您的帮助莫里斯

Answer 1

例如：

Sub Demo()
Application.ScreenUpdating = True
Dim wdApp As Object, wdDoc As Object, StrDocNm As String
Dim bStrt As Boolean, bFound As Boolean
'Check whether the document exists
StrDocNm = "C:\Users\" & Environ("Username") & "\Documents\Document Name.doc"
If Dir(StrDocNm) = "" Then
  MsgBox "Cannot find the designated document: " & StrDocNm, vbExclamation
  Exit Sub
End If
' Test whether Word is already running.
On Error Resume Next
bStrt = False ' Flag to record if we start Word, so we can close it later.
Set wdApp = GetObject(, "Word.Application")
'Start Word if it isn't running
If wdApp Is Nothing Then
  Set wdApp = CreateObject("Word.Application")
  If wdApp Is Nothing Then
    MsgBox "Can't start Word.", vbExclamation
    Exit Sub
  End If
  ' Record that we've started Word, so we can terminate it later.
  bStrt = True
End If
On Error GoTo 0
'Check if the document is open.
bFound = False
With wdApp
  .Visible = True
  For Each wdDoc In .Documents
    If wdDoc.FullName = StrDocNm Then ' We already have it open
      bFound = True
      Exit For
    End If
  Next
  ' If not open by the current user.
  If bFound = False Then
    ' Check if another user has it open.
    If IsFileLocked(StrDocNm) = True Then
      ' Report and exit if true
      MsgBox "The Word document is in use." & vbCr & "Please try again later.", vbExclamation, "File in use"
      If bStrt = True Then .Quit
      Exit Sub
    End If
    ' The file is available, so open it.
    Set wdDoc = .Documents.Open(FileName:=StrDocNm)
    If wdDoc Is Nothing Then
      MsgBox "Cannot open:" & vbCr & StrDocNm, vbExclamation
      If bStrt = True Then .Quit
      Exit Sub
    End If
  End If
  With wdDoc
    'Only now can we can process the document!!!
    .Save
    'Close the document if we opened it
    If bFound = False Then .Close
  End With
  If bStrt = True Then .Quit
End With
End Sub

Function IsFileLocked(strFileName As String) As Boolean
  On Error Resume Next
  Open strFileName For Binary Access Read Write Lock Read Write As #1
  Close #1
  IsFileLocked = Err.Number
  Err.Clear
End Function

将数据从 Excel 文件复制到打开的 Word 文件

Copy data from an Excel-File to an open Word-File

excel

vba

ms-word