目前使用Word附註應用程式的用戶已不少了,我相信也很大程度的提高了用戶的工作效率,以下介紹一下該程序的原理和實現過程,有助於大家更便捷的使用。
一、原理
該程序主要利用Word中的Link域實現。該Link域一方面可通過右鍵選擇性粘貼實現,也可通過VBA增加,本程序使用VBA批量增加。
有關Link域官方幫助可見
https://support.office.com/zh-cn/article/%E5%9F%9F%E4%BB%A3%E7%A0%81%EF%BC%9ALink-%E5%9F%9F-09422d50-cde0-4b77-bca7-6a8b8e2cddbd
其語法如下:
{ LINK 類名 "文件名" [位置引用 ] [開關 ] }
示例如下:
以下示例從 Microsoft Excel 工作表中插入某個單元格區域。\a 開關確保當 Microsoft Excel 中的工作表更改時,該信息隨之更新:
{ LINK Excel.Sheet.8 "C:\\My Documents\\Profits.xls" "Sheet1!R1C1:R4C4" \a \p }
二、實現過程
(一)基本代碼
如上所述,本程序使用VBA批量增加,基本代碼如下:
Private Sub LinkTable(rng As Range, path As String, xlRange As String, Exetstr As String)
Dim fieldText As String
Dim fld As Microsoft.Office.Interop.Word.Field
fieldText = IIf(Exetstr = "xlsm", "Excel.SheetMacroEnabled.12 ", "Excel.Sheet.12 ") & Chr(34) & path & Chr(34) & " " & Chr(34) & xlRange & Chr(34) & " \h"
rng.Collapse(direction:=WdCollapseDirection.wdCollapseEnd)
fld = rng.Fields.Add(range:=rng, type:=WdFieldType.wdFieldLink, text:=fieldText, preserveFormatting:=True)
End Sub
(二)實現結果
通過Shift+F9,可查看該帶域代碼陰影的表格的域代碼:
1、「E: \\Word附註應用程式\\Word附註應用程式\\bin\\Debug\\樣例\\W附註模板.xlsx」代表Excel文件的絕對路徑,故其用「\\」表示。附註工具中「更換路徑」,從而實現刷新不同項目的附註,即是通過替換此處路徑實現的。
2、「W附註模板」為Excel工作表名。
3、「_jds6」為該表格對應於Excel中名稱為「_jds6」的區域,之所以採用命名的方式,有助於後續增減行操作。設計該命名方式時,最初想用自己名字首拼wjb+數字,為了不那麼自戀,還是用jd吧(有點jd的意思是不)。默認情況下,程序將產生的該類名稱予以隱藏,利用VBA代碼可全顯隱藏的名稱。
全顯名稱實例:
Dim MyNAME As Name
For Each MyNAME In ThisWorkbook.Names
MyNAME.Visible = True
Next
4、「\h \* MERGEFORMAT」為開關,其中「\h」表示「插入連結對象作為 HTML格式文本」;「\* MERGEFORMAT」表示「域代碼的結果在更新時保留原格式」,該開關可使表格更新時格式不發生變化。
(三)更新域時,Word根據Excel自動增減行
如上所示,之所以採用命名區域的方式,也是考慮到Word增減行問題。增減行其實很簡單,但卻是本程序的一個核心,該解決方案最初讓我想了好幾天,百度等搜索已沒有用了,只能靠自己了。記得那是一個東北大雪紛飛的周末早上,屋裡暖氣挺足,我蹲在馬桶上,左想右想,突然,就那麼一下,咚想到了。所以很多東西就是一個窗戶紙,一捅就破了。
廢話少說,基本原理即是,在更新連結時,先提取出該名稱,再該名稱在Excel中所涉表格的行數,然後計算目前該Word表格的行數,兩者做差,多的增加,少的刪除。知道了該原理,就知道了在Excel有增減行情況下,為什麼不能用Word右鍵原生的「更新連結」了。而在執行通過附註工具的「更新連結」時,最好先將光標定位在表格標題行的下一行,也是為了便於減行時,自己不想寫更複雜的代碼,以防止不小心刪除標題等(雖然一般不會發生),雖該代碼後來還是在「標題行重複」中增加了呢。
基本代碼如下:
Dim 增減表格行數 As Integer
增減表格行數 = exceltablenum - wordtablenum
If 增減表格行數 > 0 Then
.Selection.InsertRowsBelow(增減表格行數)
Else
If 增減表格行數 < 0 Then
Dim deleterows As Integer
For deleterows = 1 To Abs(增減表格行數)
.Selection.Rows.Delete()
Next
End If
End If
With .Selection
.Tables(1).AllowAutoFit = False
.Rows.WrapAroundText = False
Dim startrange As Long
Dim endrange As Long
startrange = .Tables(1).Range.Start
endrange = .Tables(1).Range.End + 1
.SetRange(startrange + 1, endrange)
Dim myparlinespaceing As Byte
Dim myparLineSpacingRule As WdLineSpacing
myparLineSpacingRule = .ParagraphFormat.LineSpacingRule
If myparLineSpacingRule = WdLineSpacing.wdLineSpaceExactly Then
myparlinespaceing = .ParagraphFormat.LineSpacing
End If
.SetRange(.Tables(1).Range.Start, .Tables(1).Range.End + 1)
.Fields(1).Update()
Err.Clear()
With .Tables(1)
With Globals.ThisAddIn.WordApp.Selection.ParagraphFormat
.LineSpacingRule = myparLineSpacingRule
If myparLineSpacingRule = WdLineSpacing.wdLineSpaceExactly Then
.LineSpacing = myparlinespaceing
End If
End With
If TitleRept = True Then
.Rows(1).HeadingFormat = True
If Err.Number <> 0 Then
Err.Clear()
Dim ierrorows As Byte
ierrorows = 2
For i = 2 To 5
If .Cell(i, 1).Range Is Nothing Then
If Err.Number <> 0 Then
ierrorows = ierrorows + 1
Err.Clear()
End If
End If
Next
endrange = .Cell(ierrorows, 1).Range.Start - 1
If Val(endrange) <> 0 Then
With Globals.ThisAddIn.WordApp.Selection
.SetRange(startrange, endrange)
.Rows.HeadingFormat = True
.Move()
End With
End If
End If
End If
End With
End With
您在做Excel與Word數據交互時,完全也可按以上思路來設計。
三、共享文件下載路徑
https://share.weiyun.com/5xI2J0S 密碼:w8hsgm