0

Word VBA で、Excel から Word へのコンテンツのコピーを繰り返したい。

目標: 図のタイトルのリストである列 C に約 250 セルの長さの Excel ワークブックの範囲があります。これらのタイトルを「キャプション」としてWordに貼り付けたい（後で図を配置するスペースを残したり、一貫したソースキャプションを付けたりするなど）

1 つのセルのコードを書きました。250 個の異なるタイトルがすべて入力されるまで、次のセルにループして、その新しいタイトルで新しいキャプションを挿入したいと考えています。

これがコードです。サブルーチンを実行して 1 つのセルからタイトルを取得する関数を実行しています。

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
4

1 に答える 1

0

コードの一部を次のように変更して、GetExcelTitles が Paste Sub を呼び出すようにしてください。その逆ではありません。

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

于 2013-06-13T00:46:00.030 に答える