【VBA範例】：如何在Excel中操控MS Word、如何在MS Word中控制Excel

楼主
allall

如何在Excel中操控MS Word

若運用VBA得當，不但Word可以操控Excel，Excel也可以操控Word．
因為Excel無法計算字數，欲在Excel中計算字數，必須借用Word的算字功能．
下面這個程式將Excel中所選之區域貼到Word中，算出字數之後，將結果存回Excel．
====================================================

Option Explicit[code]Sub count_in_Word()
'在Excel中使用MS Word來計算稿名字數
'
'使用方法
'假設稿名旁邊那一行空白
'一、選擇要計算的稿名
'二、執行本程式
'
'In order to use this code you must set a reference to the
'Word object library by doing this. In the VB Editor click
'Tools, References. Then search for Microsoft Word n.n Object Library
'where n.n will depend on your version of Word.
'
'本程式最後修改日期：2008-8-21
'
Dim wdApp As Word.Application, wdDoc As Word.Document
Dim oWdRange As Word.Range
Dim iLoop As Integer
Dim iRow As Integer
Dim iColumn As Integer
Dim l As Integer
Dim n As Integer
Dim m As Integer
Dim iBlock As Integer
Dim iRemainder As Integer
Dim iTotalWords1 As Integer
Dim iTotalWords2 As Integer
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then 'Word isn't already running
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0
Set wdDoc = wdApp.Documents.Add("Normal", False, 0)
'儲存時間，以計算本程式之執行時間
Cells(1, 6) = Now()
ThisWorkbook.Sheets("sheet1").Select
'找出選區之第一格及總格數
With Selection
iRow = Selection.Row()
iColumn = Selection.Column()
iLoop = Selection.Rows.Count
End With
'每次處理六格
iBlock = 6
'算餘數
iRemainder = iLoop Mod iBlock
'一定得用\，不能用/．後者會自動四捨五入
m = iLoop \ iBlock
For l = 1 To m
'每六格一選
Range(Cells(iRow + (l - 1) * iBlock, iColumn), Cells(iRow + l * iBlock - 1, iColumn)).Select
With Selection
Selection.Copy
End With
'貼到MS Word
wdApp.Selection.PasteSpecial DataType:=wdPasteText
For n = 1 To iBlock
'先算總字數
iTotalWords1 = wdApp.ActiveDocument.ComputeStatistics(wdStatisticWords)
'選取第一段，刪除之後，再算總字數．二者差額即第一段之字數
Set oWdRange = wdApp.ActiveDocument.Paragraphs(1).Range
oWdRange.Delete
iTotalWords2 = wdApp.ActiveDocument.ComputeStatistics(wdStatisticWords)
'將算出之字數存回Excel
Cells(iRow + (l - 1) * iBlock + n - 1, iColumn + 1).Value = iTotalWords1 - iTotalWords2
Next n
Next l
'處理最後一段
If iRemainder Then
Range(Cells(iRow + (l - 1) * iBlock, iColumn), Cells(iRow + (l - 1) * iBlock + iRemainder - 1, iColumn)).Select
With Selection
Selection.Copy
End With
wdApp.Selection.PasteSpecial DataType:=wdPasteText
For n = 1 To iRemainder
'先算總字數
iTotalWords1 = wdApp.ActiveDocument.ComputeStatistics(wdStatisticWords)
'選取第一段，刪除之後，再算總字數．二者差額即第一段之字數
Set oWdRange = wdApp.ActiveDocument.Paragraphs(1).Range
oWdRange.Delete
iTotalWords2 = wdApp.ActiveDocument.ComputeStatistics(wdStatisticWords)
Cells(iRow + (l - 1) * iBlock + n - 1, iColumn + 1).Value = iTotalWords1 - iTotalWords2
Next n
End If
Cells(2, 6) = Now()
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
wdDoc.Close False
wdApp.Quit
End Sub

如何在MS Word中控制Excel

VBA的功能相當完備，可以由一個微軟程式來控制另一個微軟程式，例如它可以讓Excel控制Word，也可以讓Word控制Excel．今天先介紹如何由Word來控制Excel．
因為Excel並無計算字數的功能，所以想要計算字數時，只好借重Word．下面這個例子是先將要計算字數的那些格子貼到Word，Word算了字數後，會將結果直接輸到Excel．
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

Option Explicit
'本程式計算每一段之字數，
'然後將結果存於Excel檔案中
'
'使用方法
'一、將要計算之格子由Excel(file1.xlsm)貼到Word(test.docx)裡
'二、執行本程式
'假設：file1.xlsm之第四行用以儲存字數，第六行之第一、二格儲存時間，
'以計算程式執行時間．
'
'
'使用前要先選用Excel Object Library．方法如下：
' 在Word裡，先進入VBA（Word 2007：developer/VB）然後選 Tools/References……接著勾選
'Microsoft Excel x.x Object Library．我的 x.x 是 12.0)
Sub count_words_table()
Dim oWdRange As Word.Range
Dim iTotalWords1 As Integer
Dim iTotalWords2 As Integer
Dim iLoop As Integer
Dim n As Integer
Dim oRow As Row
Dim oXL As Excel.Application
Dim oWB As Excel.Workbook
Dim oRng As Excel.Range
Dim ExcelWasNotRunning As Boolean
Dim WorkbookToWorkOn As String
Application.ScreenUpdating = False
'指定所要使用之 Excel 檔案名稱
WorkbookToWorkOn = "C:\Documents and Settings\me\My Documents\file1.xlsm"
Windows("test.docx").Activate
'隱藏視窗，執行速度較快
Application.Visible = False
'If Excel is running, get a handle on it; otherwise start a new instance of Excel
On Error Resume Next
Set oXL = GetObject(, "Excel.Application")
If Err Then
ExcelWasNotRunning = True
Set oXL = New Excel.Application
End If
On Error GoTo Err_Handler
'打開 Excel 檔案
Set oWB = oXL.Workbooks.Open(FileName:=WorkbookToWorkOn)
oWB.Application.ScreenUpdating = False
'儲存程式開始執行的時間，用以計算本程式執行時間
oXL.ActiveWorkbook.Worksheets("綜合").Cells(1, 6).Value = Now()
'計算總共執行次數，一段一次
iLoop = ActiveDocument.ComputeStatistics(wdStatisticParagraphs)
For n = 1 To iLoop
'先算總共的字數
iTotalWords1 = ActiveDocument.ComputeStatistics(wdStatisticWords)
'選取第一段，刪去，再算字數．二者之差即第一段之字數
Set oWdRange = ActiveDocument.Paragraphs(1).Range
oWdRange.Delete
iTotalWords2 = ActiveDocument.ComputeStatistics(wdStatisticWords)
'直接將結果儲存到 Excel 檔中
oXL.ActiveWorkbook.Worksheets("sheet1").Cells(n, 4).Value = iTotalWords1 - iTotalWords2
Next n
'儲存程式結束的時間
oXL.ActiveWorkbook.Worksheets("綜合").Cells(2, 6).Value = Now()
oWB.Save
oWB.Close False
'quit
If ExcelWasNotRunning Then
oXL.Quit
End If
'Make sure you release object references.
Set oWB = Nothing
Set oXL = Nothing
Application.ScreenUpdating = True
Application.Visible = True
Exit Sub
Err_Handler:
MsgBox WorkbookToWorkOn & " caused a problem. " & Err.Description, vbCritical, _
"Error: " & Err.Number
If ExcelWasNotRunning Then
oXL.Quit
End If
End Sub

2楼
omnw

为了方便阅读代码,请将你帖子中的代码按照我编辑后的样子.
帖子的内容较多,建议拆分成两个帖子.

3楼
hwh6963

能否给一附件说明，谢谢