使用字典和书签将数据从Excel传输到Word

Question

我正在寻找一种方法，可以将电子表格中的数据（通过使用字典附件）传输到Word文档中的设置书签中。

最终产品将需要遍历电子表格中的每一行数据-然后-将数据填入当前的Word书签中-然后-删除先前的书签-然后-继续循环...

但是，如果有人能一次帮助我将excel中的数据以单词的形式传递给书签，我将非常感激，因为我可以轻松地从那里运行它。

这是我到目前为止的内容（我被卡在代码的底部！）：

Dim columnLocations As New Dictionary
Dim bookmarkOrder As New Dictionary
Dim solutionWorkbook As Workbook

Sub Main()
  Set solutionWorkbook = ActiveWorkbook

  columnLocations.RemoveAll
  bookmarkOrder.RemoveAll

  Call PopulateColumnLocations
  Call PopulateBookmarkMappings
  Call DictionaryData
End Sub

Sub PopulateColumnLocations()
  'Loop through row1 to populate dictionary. key = header name, value = column number
  Sheets("Data").Select
  For Each cell In solutionWorkbook.Worksheets("Data").Range("A10", Range("A10").End(xlToRight)).Cells
    columnLocations.Add Trim(cell.Value), cell.Column
  Next
End Sub

Sub PopulateBookmarkMappings()
  'Loop through row1 to populate dictionary. key = header name, value = collumn number
   Sheets("Mappings").Select
  Dim Var As Object
  Dim Key As Object

  For Each cell In solutionWorkbook.Worksheets("Mappings").Range("A2", Range("A2").End(xlDown)).Cells
    Debug.Print Cells(cell.Row, 2).Value
    Debug.Print cell.Value
    bookmarkOrder.Add Trim(cell.Value), Cells(cell.Row, 2).Value 'the 2 is the column which has the bookmark name in
  Next
End Sub

Sub DictionaryData()
  Sheets("Data").Select
  Dim count As Integer
  count = 1
  'Loop through all rows in input data sheet
  For Each cell In solutionWorkbook.Worksheets("Data").Range("A11", Range("A11").End(xlDown)).Cells
    Dim TweetSummary As String
    TweetSummary = solutionWorkbook.Sheets("Data").Cells(cell.Row, columnLocations.Item("Summary")).Value

    Dim TweetDate As String
    TweetDate = solutionWorkbook.Sheets("Data").Cells(cell.Row, columnLocations.Item("Date")).Value

    Dim TweetURL As String
    TweetURL = solutionWorkbook.Sheets("Data").Cells(cell.Row, columnLocations.Item("URL")).Value

    Dim TweetFollowers As String
    TweetFollowers = solutionWorkbook.Sheets("Data").Cells(cell.Row, columnLocations.Item("Twitter Followers")).Value

    Dim TweetFollowing As String
    TweetFollowing = solutionWorkbook.Sheets("Data").Cells(cell.Row, columnLocations.Item("Twitter Following")).Value

    Dim TweetTweets As String
    TweetTweets = solutionWorkbook.Sheets("Data").Cells(cell.Row, columnLocations.Item("Twitter Tweets")).Value

  Next
End Sub

Sub Worddoc()
  Dim LaunchWord As Object
  Dim tweetWord As Object
  Dim Path As String
  Dim tBookmark As Bookmark
  Path = solutionWorkbook.Path & "\B_watch_social_twitter_template.dot"

  Set LaunchWord = CreateObject("Word.Application")
  Set tweetWord = LaunchWord.Documents.Add(Path)

  tweetWord.Select

 ''IM STUCK HERE!!!
End Sub

Answer 1

http://www.dailydoseofexcel.com/archives/2004/08/13/automating-word/

我认为这就是您所需要的。