Ctrl + Alt + Shift + o ： **單字**檢索[《說文解字》網站](https://www.shuowen.org/…

…)並取回其解釋欄位及段注本內容與網址值插入至插入點位置，並予以適當的格式化。 （o= 說文解字 ShuoWen.ORG 的 O）

README.md

@@ -308,6 +308,7 @@ Ctrl + F12 ：檢索《國語辭典》
 - Alt + v ： **單字**檢索《異體字字典》並讀入其《說文》及網址資料以便引文。
 - Alt + n ： **單字**檢索《漢語多功能字庫》並取回其說文解釋欄位之值插入至插入點位置。 （n= 能 neng）
 - Alt + o ： **單字**檢索[《說文解字》網站](https://www.shuowen.org/)並取回其解釋欄位及網址值插入至插入點位置。 （o= 說文解字 ShuoWen.ORG 的 O）
+- Ctrl + Alt + Shift + o ： **單字**檢索[《說文解字》網站](https://www.shuowen.org/)並取回其解釋欄位及段注本內容與網址值插入至插入點位置，並予以適當的格式化。 （o= 說文解字 ShuoWen.ORG 的 O）
 - Ctrl + Alt + x ： **單字**檢索《康熙字典網上版》（x = xi 熙）
 - Ctrl + d + s （按住 Ctrl 依序按d、s） ：檢索《國學大師》（ds：大師 da-shi 的 d、s）
 - Alt + g ： 以選取文字檢索Google

WordVBA/Keywords.bas

@@ -9,7 +9,7 @@ Property Get 
         "老陰", "老陽", "少陰", "少陽", "蓍")
 End Property
 Rem 用以標識易學關鍵字用
-Property Get 易學KeywordsToMark() As Variant 'string()
+Property Get 易學KeywordsToMark() As Variant 'string()因為 Array Returns a Variant containing an array,所以不能寫成 as string()
     易學KeywordsToMark = Array("易", "周易", "易經", "大易", "五經", "六經", "七經", "十三經", "蓍", _
         "卦", "節卦", "離卦", _
         "爻", _

WordVBA/Network.bas

@@ -167,7 +167,7 @@ Sub 
                 End If
             End With
         End With
-    Else
+    Else 'ar(0)不為空時
         Dim ur As UndoRecord, fontsize As Single
         SystemSetup.stopUndo ur, "查漢語多功能字庫並取回其說文解釋欄位之值插入至插入點位置"
         With Selection
@@ -179,8 +179,8 @@ Sub 
                 .Collapse wdCollapseEnd
             End If
             '插入取回的《說文》內容
-            .TypeText "，《說文》云："
-            .InsertAfter ar(0) & VBA.Chr(13) 'ar(0)=《說文》內容
+            .TypeText "，《說文》云：「"
+            .InsertAfter ar(0) & "」" & VBA.Chr(13) 'ar(0)=《說文》內容
             .Collapse wdCollapseEnd
             If Selection.End = Selection.Document.Range.End - 1 Then
                 Selection.Document.Range.InsertParagraphAfter
@@ -221,7 +221,60 @@ Sub 
                 End If
             End With
         End With
-    Else
+    Else 'ar(0)不為空時
+        Dim ur As UndoRecord, fontsize As Single
+        SystemSetup.stopUndo ur, "查說文解字並取回其解釋欄位及網址值插入至插入點位置"
+        With Selection
+            fontsize = VBA.IIf(.Font.Size = 9999999, 12, .Font.Size) - 4
+            If fontsize < 0 Then fontsize = 10
+            If .Type = wdSelectionIP Then
+                .Move
+            Else
+                .Collapse wdCollapseEnd
+            End If
+            .TypeText "，《說文》云：「"
+            .InsertAfter ar(0) & "」" & VBA.Chr(13) 'ar(0)=《說文》內容
+            .Collapse wdCollapseEnd
+            If Selection.End = Selection.Document.Range.End - 1 Then
+                Selection.Document.Range.InsertParagraphAfter
+            End If
+            .Font.Size = fontsize
+            .InsertAfter ar(1) '插入網址
+            SystemSetup.contiUndo ur
+            .Collapse wdCollapseStart
+            With .Application
+                .Activate
+                With .ActiveWindow
+                    If .WindowState = wdWindowStateMinimize Then
+                        .WindowState = wdWindowStateNormal
+                        .Activate
+                    End If
+                End With
+            End With
+        End With
+    End If
+End Sub
+Sub 查說文解字並取回其解釋欄位段注及網址值插入至插入點位置()
+    Rem  Ctrl+ Shift + Alt + o （o= 說文解字 ShuoWen.ORG 的 O）
+    If Selection.Characters.Count > 1 Then
+        MsgBox "限查1字", vbExclamation ', vbError
+        Exit Sub
+    End If
+    Dim ar 'As Variant
+    ar = SeleniumOP.LookupShuowenOrg(Selection.text, True)
+    If ar(0) = vbNullString Then
+        word.Application.Activate
+        MsgBox "找不到，或網頁當了或改版了！", vbExclamation
+        With Selection.Application
+            .Activate
+            With .ActiveWindow
+                If .WindowState = wdWindowStateMinimize Then
+                    .WindowState = wdWindowStateNormal
+                    .Activate
+                End If
+            End With
+        End With
+    Else 'ar(0)不為空時
         Dim ur As UndoRecord, fontsize As Single
         SystemSetup.stopUndo ur, "查說文解字並取回其解釋欄位及網址值插入至插入點位置"
         With Selection
@@ -235,9 +288,37 @@ Sub 
             .TypeText "，《說文》云："
             .InsertAfter ar(0) & VBA.Chr(13) 'ar(0)=《說文》內容
             .Collapse wdCollapseEnd
+            '插入段注內容
+            .InsertAfter "段注本：" & VBA.IIf(VBA.Asc(VBA.Left(ar(2), 1)) = 13, vbNullString, VBA.Chr(13)) & ar(2) & VBA.Chr(13)
             If Selection.End = Selection.Document.Range.End - 1 Then
                 Selection.Document.Range.InsertParagraphAfter
             End If
+            Dim p As Paragraph, s As Byte, sDuan As Byte
+            s = VBA.Len("                                ") '段注本的說文
+            sDuan = VBA.Len("                ") '段注本的段注文
+reCheck:
+            For Each p In .Paragraphs
+                If VBA.InStr(p.Range.text, "清代 段玉裁《說文解字注》") Then
+                    p.Range.Delete
+                    GoTo reCheck:
+                ElseIf VBA.Replace(p.Range.text, " ", "") = Chr(13) Then
+                    p.Range.Delete
+                    GoTo reCheck:
+                ElseIf VBA.Left(p.Range.text, s) = VBA.space(s) Then '段注本的說文
+                    p.Range.text = Mid(p.Range.text, s + 1)
+                ElseIf VBA.Left(p.Range.text, sDuan) = VBA.space(sDuan) Then '段注本的段注文
+                    With p.Range
+                        .text = Mid(p.Range.text, sDuan + 1)
+                        With .Font
+                            .Size = fontsize + 2
+                            .ColorIndex = 11 '.Font.Color= 34816
+                        End With
+                    End With
+                End If
+            Next p
+            .Collapse wdCollapseEnd
+
+            '網址格式設定
             .Font.Size = fontsize
             .InsertAfter ar(1) '插入網址
             SystemSetup.contiUndo ur
@@ -262,7 +343,9 @@ Sub 
     End If
     Dim ar As Variant, x As String
     x = Selection.text
+
     ar = SeleniumOP.LookupDictionary_of_ChineseCharacterVariants_RetrieveShuoWenData(x)
+
     If ar(0) = vbNullString Then
         word.Application.Activate
         MsgBox "找不到，或網頁當了或改版了！", vbExclamation
@@ -275,7 +358,7 @@ Sub 
                 End If
             End With
         End With
-    Else
+    Else '如果ar(0)非空字串（空值）
         Dim ur As UndoRecord, fontsize As Single
         SystemSetup.stopUndo ur, "查異體字字典並取回其說文釋形欄位及網址值插入至插入點位置"
         With Selection
@@ -286,11 +369,26 @@ Sub 
             Else
                 .Collapse wdCollapseEnd
             End If
-            .TypeText "，《說文》：" & VBA.Chr(13)
+            Dim s As Byte
+            s = VBA.InStr(ar(0), "《說文》不錄。")
+            If s = 0 Then
+                If ar(0) = "說文釋形沒有資料！" Then
+                    .TypeText VBA.Chr(13)
+                Else
+                    .TypeText "，《說文》：" & VBA.Chr(13)
+                End If
+            Else
+                 .TypeText "，" & VBA.Mid(ar(0), s) & VBA.Chr(13)
+            End If
             Dim shuoWen As String
             shuoWen = VBA.Replace(VBA.Replace(ar(0), "：，", "：" & x & "，"), "段注本：", VBA.Chr(13) & "段注本：")
-            .InsertAfter shuoWen & VBA.Chr(13)  'ar(0)=《說文》內容
-            .Collapse wdCollapseEnd
+            If VBA.Left(shuoWen, 1) = "，" Then
+                shuoWen = x & shuoWen
+            End If
+            If s = 0 And ar(0) <> "說文釋形沒有資料！" Then
+                .InsertAfter shuoWen & VBA.Chr(13)  'ar(0)=《說文》內容
+                .Collapse wdCollapseEnd
+            End If
             If Selection.End = Selection.Document.Range.End - 1 Then
                 Selection.Document.Range.InsertParagraphAfter
             End If

WordVBA/SeleniumOP.bas

@@ -1220,11 +1220,11 @@ Select Case Err.Number
     End Select
 End Function
 
-Rem 查《說文解字》取回其《說文》「解釋」欄位的內容：x 要查的字。傳回一個字串陣列，第1個元素是《說文》「解釋」的內容字串，第2個元素是查詢結果網址。若沒找到，則傳回空字串陣列
-Function LookupShuowenOrg(x As String) As String()
+Rem 查《說文解字》取回其《說文》「解釋」欄位的內容：x 要查的字,includingDuan 是否也傳回段注內容。傳回一個字串陣列，第1個元素是《說文》（大徐本）「解釋」的內容字串，第2個元素是查詢結果網址，第3個則是段注之內容。若沒找到，則傳回空字串陣列
+Function LookupShuowenOrg(x As String, Optional includingDuan As Boolean) As String()
     On Error GoTo eH
-    Dim result(1) As String '1=索引值上限（最大值）
-    LookupShuowenOrg = result
+    Dim result(2) As String '2=索引值上限（最大值 = UBound 傳回值）
+    LookupShuowenOrg = result '先設定好要傳回的字串陣列，當沒賦予值時就是傳回空字串的陣列
     If Not code.IsChineseCharacter(x) Then
         Exit Function
     End If
@@ -1263,12 +1263,30 @@ Function LookupShuowenOrg(x As String) As String()
             Exit Function
         End If
     End If
-
+    '釋文欄的內容
     Set iwe = wd.FindElementByCssSelector("body > div.container.main > div > div.col-md-9.main-content.pull-right > div.row.summary > div.col-md-9.pull-left.info-container > div.media.info-body > div.media-body")
     GoSub iweNothingExitFunction
-
     result(0) = iwe.text
     result(1) = wd.URL
+    '取得段注本內容
+    If includingDuan Then
+        Dim i As Byte
+        i = 1
+        'Dim duanCommentary As String
+        '取得段注本內容框的元件
+        Set iwe = wd.FindElementByCssSelector("body > div.container.main > div > div.col-md-9.main-content.pull-right > div:nth-child(" & i & ") > div")
+        Do
+            If i > 30 Then Exit Do
+            If Not iwe Is Nothing Then
+                If VBA.InStr(iwe.GetAttribute("textContent"), "清代 段玉裁《說文解字注》") Then Exit Do
+            End If
+            Set iwe = wd.FindElementByCssSelector("body > div.container.main > div > div.col-md-9.main-content.pull-right > div:nth-child(" & i & ") > div")
+            i = i + 1
+        Loop
+        GoSub iweNothingExitFunction
+        result(2) = iwe.GetAttribute("textContent") '=duanCommentary
+    End If
+
     LookupShuowenOrg = result
     Exit Function
 
@@ -1363,7 +1381,16 @@ plural: '
                 Loop
             End If
             iwe.Click
-            '說文釋形
+            '先檢查 說文釋形 儲存格 內的文字是否是「說文釋形」
+            Set iwe = wd.FindElementByCssSelector("#view > tbody > tr:nth-child(2) > th")
+            GoSub iweNothingExitFunction
+            If iwe.GetAttribute("textContent") <> "說文釋形" Then
+                Set iwe = Nothing
+                result(0) = "說文釋形沒有資料！"
+                result(1) = wd.URL
+                GoSub iweNothingExitFunction
+            End If
+            '說文釋形 儲存格元件右邊的儲存格
             Set iwe = wd.FindElementByCssSelector("#view > tbody > tr:nth-child(2) > td")
             GoSub iweNothingExitFunction
             result(0) = iwe.GetAttribute("textContent")
@@ -1375,7 +1402,17 @@ plural: '
         '字頭元件
         Set iwe = wd.FindElementByCssSelector("#header > section > h2 > span > a")
         If iwe Is Nothing = False Then
-            '說文釋形
+
+            '先檢查 說文釋形 儲存格 內的文字是否是「說文釋形」
+            Set iwe = wd.FindElementByCssSelector("#view > tbody > tr:nth-child(2) > th")
+            GoSub iweNothingExitFunction
+            If iwe.GetAttribute("textContent") <> "說文釋形" Then
+                Set iwe = Nothing
+                result(0) = "說文釋形沒有資料！"
+                result(1) = wd.URL
+                GoSub iweNothingExitFunction
+            End If
+            '說文釋形 儲存格元件右邊的儲存格
             Set iwe = wd.FindElementByCssSelector("#view > tbody > tr:nth-child(2) > td")
             GoSub iweNothingExitFunction
             result(0) = iwe.GetAttribute("textContent")