2009-12-05 34 views
0

我需要從Excel中獲取名稱列表,並將它們插入到Word文檔中,爲每個名稱打印一個文檔。該文件有一些文本和一個名爲「名稱」的書籤。代碼如下。關於Word宏的幾個問題

首先,我想知道是否有可能在Excel電子表格中檢測名稱列表的多長時間並獲取該名稱,而不是硬編碼該數字。

其次,我想不出如何刪除我已經放在文檔中的文本。當我在書籤中插入文本時,它會在書籤後追加,因此如果我不斷添加名稱,它們將全部疊加在一起。

也許與代碼,這將是更清楚:

Sub insertar_nombre() 
    Dim Excel As Excel.Application 
    Dim Planilla As Excel.Workbook 
    Dim Hoja As Excel.Worksheet 

    Set Excel = CreateObject("Excel.Application") 
    Dim Filename As String 
    Dim fname As Variant 
    With Application.FileDialog(msoFileDialogOpen) 
     .AllowMultiSelect = False 
     .Title = "Seleccionar Documento de Excel" 
     .Show 
     For Each fname In .SelectedItems 
      Filename = fname 
     Next 
    End With 
    Set Planilla = Excel.Workbooks.Open(Filename) 
    Set Hoja = Planilla.Worksheets(1) 
    Dim Nombre As String 
    For Count = 2 To 10 
     Nombre = Hoja.Cells(Count, 1).Value 
     ActiveDocument.Bookmarks("name").Range.Text = Nombre 
     ActiveDocument.PrintOut 
    Next 
End Sub 

原諒我,如果這個代碼顯然是錯誤什麼的,我只是這個開始。

回答

0

我需要從Excel中獲取名稱列表並將它們插入到Word文檔中,併爲每個名稱打印一個文檔。

你爲什麼不簡單地使用郵件合併功能?

+0

我知道這一點,我只是想做這個手動的方式來獲得樂趣。 – Javier

0

以下Sub應該爲您解決這個問題,但您可能需要更改書籤的定義方式。

有多種方法insert a Bookmark。此方法要求通過突出顯示文本插入書籤,而不是簡單地將光標放置在文本中的某個位置。

Sub insertar_nombre() 

Dim xlWorkbook As Excel.Workbook 
Dim xlWorksheet As Excel.Worksheet 

Dim strFilename As String 

Dim bkmName As Word.Range 
Dim strBookmarkOriginalText As String 

Dim lngRowLast As Long 
Dim rngRowStart As Excel.Range 
Dim rngRowEnd As Excel.Range 

Dim rngNames As Excel.Range 
Dim rngName As Excel.Range 


'Open file dialog and only allow Excel files' 
With Application.FileDialog(msoFileDialogOpen) 
    .AllowMultiSelect = False 
    .Title = "Seleccionar Documento de Excel" 

    'Only let them select Excel files' 
    .Filters.Clear 
    .Filters.Add "Excel Documents (*.xls)", "*.xls" 

    'Check if a file is selected' 
    If .Show = True Then 

     'Since AllowMultiSelect is set to False, _ 
      only one file can be selected' 
     strFilename = .SelectedItems(1) 
    Else 

     'No file selected, so exit the Sub' 
     Exit Sub 
    End If 
End With 


'Set the bookmark to a Word range (not a Bookmark object)' 
Set bkmName = ActiveDocument.Bookmarks("name").Range 

'Save the original text of the bookmark' 
strBookmarkOriginalText = bkmName.Text 


'Open the Excel file' 
Set xlWorkbook = Excel.Workbooks.Open(strFilename) 
Set xlWorksheet = xlWorkbook.Worksheets(1) 

'Range of the first cell that contains a name' 
Set rngRowStart = xlWorksheet.Cells(2, 1) 

'Range of the last cell in the column' 
lngRowLast = xlWorksheet.Range("A65536").End(xlUp).Row 
Set rngRowEnd = xlWorksheet.Cells(lngRowLast, 1) 

'Range of all cells from first name cell to last name cell' 
Set rngNames = xlWorksheet.Range(rngRowStart, rngRowEnd) 


'Loop through the range of names' 
For Each rngName In rngNames 

    'Ignore any blank cells' 
    If rngName <> vbNullString Then 

     'Set the text of the bookmark range to the name from Excel' 
     bkmName.Text = rngName 

     'The above statement deleted the Bookmark, so create _ 
      a new Bookmark using the range specified in bkmName' 
     ActiveDocument.Bookmarks.Add Name:="name", Range:=bkmName 

     'Print the document' 
     ActiveDocument.PrintOut 
    End If 
Next 


'Restore the orignal value of the bookmark' 
bkmName.Text = strBookmarkOriginalText 
ActiveDocument.Bookmarks.Add Name:="name", Range:=bkmName 

'Close the Workbook without saving' 
xlWorkbook.Close SaveChanges:=False 

End Sub 

希望這會有所幫助。