字體：小 中 大 |
|
|
|
| 2008/08/23 21:52:48瀏覽11494｜回應0｜推薦3 | |
|
相關文章： 【VBA範例】：含有合併欄之Excel檔案如何排序 【VBA範例】：如何在MS Word中控制Excel 若運用VBA得當，不但Word可以操控Excel，Excel也可以操控Word． 因為Excel無法計算字數，欲在Excel中計算字數，必須借用Word的算字功能． 下面這個程式將Excel中所選之區域貼到Word中，算出字數之後，將結果存回Excel． ==================================================== Option Explicit 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 ============================================== 相關文章： VBA範例：含有合併欄之Excel檔案如何排序 VBA範例：如何在MS Word中控制Excel |
|
| ( 興趣嗜好｜電腦3C ) |
