使用词典&amp ;;将数据从Excel传输到Word书签

时间:2012-05-09 14:47:54

标签: excel vba ms-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

1 个答案:

答案 0 :(得分:1)