Question

我想在Word VBA中重复将内容从Excel复制到Word。

目标：我在Excel工作簿中有一个范围，在C列中有大约250个单元格，这是一个图标题列表。我想将这些标题粘贴到Word中，作为“标题”（同时留出空间来放置数字，为它们添加一致的源标题等）。

我为一个单元格编写代码。我想循环到下一个单元格并插入一个新标题，直到输入所有250个不同的标题。

这是代码。我让它运行一个函数，它运行一个子函数从一个单元格中获取标题。

Sub Macro123()
Selection.InsertCaption Label:="Figure", TitleAutoText:="InsertCaption2", _
Title:=".", Position:=wdCaptionPositionBelow, ExcludeLabel:=0
Selection.TypeText Text:=TitleDrop
Selection.Style = ActiveDocument.Styles("EcoCaption")
Selection.TypeParagraph
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Selection.TypeParagraph
Selection.TypeText Text:="Source: Current study, based off landings data from CDFW."
Selection.Style = ActiveDocument.Styles("EcoSource")
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
End Sub
-----------
Function TitleDrop()
GetExcelTitles
Selection.PasteAndFormat (wdFormatPlainText)

End Function
-----------------

Sub GetExcelTitles()
Dim ObjXL As Object, xlWkBk
Dim strTitleName As String

On Error Resume Next
Set ObjXL = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
    MsgBox "No Excel Files are open (Excel is not running)"
    Exit Sub
End If
For Each xlWkBk In ObjXL.Workbooks
    If xlWkBk.Name = "130611 Figure Lists.xlsx" Then
        xlWkBk.Sheets("Figuresonly").Range("C6").Select
        xlWkBk.Sheets("Figuresonly").Range("C6").Copy
        Exit For
    End If
Next
Set ObjXL = Nothing

End Sub

Answer 1

尝试将一些代码更改为如下所示，并使GetExcelTitles调用您的粘贴子，而不是相反。

Dim rng as Range

For Each xlWkBk In ObjXL.Workbooks
If xlWkBk.Name = "130611 Figure Lists.xlsx" Then

For each xlWkBk.Sheets("Figuresonly").Range("C1", "C250")
  rng.Select
  rng.Copy
  Call TitleDrop
Next

End If
Next

干杯，LC

将单元格中的单元格从Excel中循环粘贴到Word中

1 个答案: