六十四卦可以藉由六個數字長度的二進位字元來表示。
但在各種不同的變化中，諸如錯卦、互卦、綜卦/覆卦、各式應卦的變化，會造成衆多的組合，不易記憶。
筆者特別使用 Excel 加以列表，並配合 VBA 函式的撰寫，做出此 易經64卦匯總表 供大衆參考。
後續找空，再跟大家介紹此表如何產生！
First Post : 2025/05/09
Excel VBA 處理圖片(Picture)的基本知識
本文的緣由，是期望在Excel VBA 的環境裡，處理製作出好看的【單字卡】，希望字卡中有文字、圖片等元素。
例如：
在此介紹一些處理文字、圖片(Picture)的基本知識：
上圖中所有的文字、圖片名稱或是網路URL位置都是記錄在同一檔案的另一個工作表裡，它被條列成清單形式，如此資料也可以容易被維護。
- 要將【工作表Ａ】中【儲存格Ａ】的文字資料，寫到存放單字卡的【工作表Form】裡面。
srcRow = ActiveCell().Row
srcCol = ActiveCell().Column
Sheets("Form").Cells(2, "C") = Cells(srcRow, "C")
Sheets("Form").Cells(3, "C") = Cells(srcRow, "G")
圖片資料的處理，有些觀念要知道！
- 已經存在的圖片，無法直接以”更改“圖片名稱或是網路URL位置方式，來變幻圖片。
需要改以刪除舊圖片，再新加圖片來處理。 - 得知工作表中圖片數量
ActiveSheet.Shapes.Count
--> 2 表示該工作表中，有兩張”圖片“。 - 得知工作表中”特定“圖片的名稱
ActiveSheet.Shapes(1).Name
--> Picture 1 在中文環境中，你可能會看到的名稱是【圖片1】
ActiveSheet.Shapes(2).Name
--> Picture 2 在中文環境中，你可能會看到的名稱是【圖片2】 - 要更改圖片名稱
ActiveSheet.Shapes(1).Name = ”BackGroup” - 刪除特定圖片
ActiveSheet.Shapes(2).Delete - 要刪除工作表中的所有圖片！
ActiveSheet.Shapes.SelectAll
Selection.Delete - 新增圖片
Sheets("Form").Select
ActiveSheet.Pictures.Insert(strPicName).Select
變數 strPicName 是圖片的檔案路徑或是該圖片存放在網路中的URL位置。
例如：
D:\Hebrew_Learning\Hebrew@TW\imags\Quran.jpg
https://d1pra95f92lrn3.cloudfront.net/media/thumb/9722_fit160.jpg - 控制圖片的尺寸大小
ActiveSheet.Pictures.Insert(strPicName).Select
sImageCell = "B3"
With Selection.ShapeRange
.Top = Range(sImageCell).Top + 2
.Left = Range(sImageCell).Left + 4
.Height = 100 ' Range(sImageCell).Height - 40
.Width = 100 ' Range(sImageCell).Width - 40
End With
Excel 資料處理技巧
先以上圖為例，來說明這次要解決的問題是什麼？
首先，若是純粹以上圖來看，它只不過是將上面的橫向資料 D1, D2, D3, D4，轉置成下面的縱向資料呈現。
若是這樣，只要將這一筆資料加以轉置，就可以完成。
現在，將問題加以擴大：
- 資料筆數繁多
- 需要轉置的資料區塊，長度不一。
這種情形，該如何處理，而且希望處理的動作，不要太慢！
解決方案：（想當然爾，程式處理才是上上策！！）
程式使用到的技巧：
- 插入空白行
- 資料轉置貼上（選擇性貼上／轉置），資料複製來源不可以和貼上的位置重疊！
- 資料的刪除
Dim srcRow As Long
Dim srcCol As Long
Dim intCnt As Integer
Dim strLoc As String
srcRow = ActiveCell().Row
srcCol = ActiveCell().Column
intCnt = 5
strLoc = "D"
Rows(srcRow + 1 & ":" & srcRow + intCnt - 1).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove '插入空白行
Range(Chr(Asc(strLoc) + 1) & srcRow & ":" & Chr(Asc(strLoc) + intCnt - 1) & srcRow).Select ‘選定資料
Selection.Copy ‘複製
Range(strLoc & srcRow + 1).Select ‘移位到指定位置
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True '資料轉置貼上
Range(Chr(Asc(strLoc) + 1) & srcRow & ":" & Chr(Asc(strLoc) + intCnt - 1) & srcRow).Select '資料刪除
Selection.ClearContents
Range(strLoc & srcRow + intCnt).Select ‘移位到指定位置
Excel 圖形處理的程式化
本文實際上是【Hebrew Flashcards 字型彙整】的延伸，但是談論的重點則着眼在 Excel 圖形的處理與程式管控的技巧。
首先，看下 01 ancient.jpg 圖檔的圖形及屬性資料，可以知道它是個 197 * 195 像素的圖檔。
要在 Excel 中，將該圖形檔案插入進來，就需要執行：插入／圖片／從檔案 …
以下說明圖形處理過程，所需用到的程式碼：
Selection.ShapeRange.Width = 38 ' (72 / 2.54) * 1.4
首先，看下 01 ancient.jpg 圖檔的圖形及屬性資料，可以知道它是個 197 * 195 像素的圖檔。
要在 Excel 中，將該圖形檔案插入進來，就需要執行：插入／圖片／從檔案 …
 | 當然插入後的圖形大小，還是會像上面圖形一樣，不會像下圖紅色圓框中的小圖形。 要變成小圖形，就要處理圖形：由大要變小 在Excel中，插入的第一張圖片，它的名稱：圖片1 第二張就是圖片2，同理，以此類推！ 但在程式管控中，圖片則以 Picture 表示。 開啟已經插入過圖片的Excel檔案，若是需要新插入的圖片名稱仍然由圖片1產生，唯一方法就是在該檔案存檔前，先選取所有的圖片，並加以刪除之。ActiveSheet.Shapes.SelectAll Selection.Delete |
以下說明圖形處理過程，所需用到的程式碼：
- 記錄 Excel 檔案的存放路徑
strFilePath = Application.ActiveWorkbook.Path - 選取所有的圖片，並加以刪除
ActiveSheet.Shapes.SelectAll
Selection.Delete - 設定存放縮小圖片的儲存格高度
' set Row Height
Rows("2:23").Select: Selection.RowHeight = 40 - 逐一插入 22個字母、四種字型圖檔
For i = 1 To 22
ActiveSheet.Pictures.Insert(strFilePath + "\jpg\" + Format(i, "00") + " ancient.jpg").Select
ActiveSheet.Pictures.Insert(strFilePath + "\jpg\" + Format(i, "00") + " block.jpg").Select
ActiveSheet.Pictures.Insert(strFilePath + "\jpg\" + Format(i, "00") + " cursive.jpg").Select
ActiveSheet.Pictures.Insert(strFilePath + "\jpg\" + Format(i, "00") + " book.jpg").Select
Next - 設定圖片縮小後的尺寸
ActiveSheet.Shapes.SelectAll
Selection.ShapeRange.LockAspectRatio = msoFalse
' Selection.ShapeRange.LockAspectRatio = msoTrue
Selection.ShapeRange.Width = 38 ' (72 / 2.54) * 1.4
- 將縮小圖片，逐一放置到指定位置上；程式碼 Int(i / 4) 是在做圖素計算的精度修正！
' set Position
sPos = 18
For i = 1 To 22
ActiveSheet.Shapes("Picture " + Format((i - 1) * 4 + 1, "#")).Select: Selection.ShapeRange.Left = 227: Selection.ShapeRange.Top = sPos + 40 * (i - 1) - Int(i / 4)
ActiveSheet.Shapes("Picture " + Format((i - 1) * 4 + 2, "#")).Select: Selection.ShapeRange.Left = 295: Selection.ShapeRange.Top = sPos + 40 * (i - 1) - Int(i / 4)
ActiveSheet.Shapes("Picture " + Format((i - 1) * 4 + 3, "#")).Select: Selection.ShapeRange.Left = 363: Selection.ShapeRange.Top = sPos + 40 * (i - 1) - Int(i / 4)
ActiveSheet.Shapes("Picture " + Format((i - 1) * 4 + 4, "#")).Select: Selection.ShapeRange.Left = 431: Selection.ShapeRange.Top = sPos + 40 * (i - 1) - Int(i / 4)
Next
去除跨欄置中、自動填補空白內容
繼續【Excel VBA 的小技巧 - 03】的話題後，再來談論一個很實用的技巧。
因為太實用的，所以文章標題就直接以話題重點來標示，而不是延伸為 Excel VBA 的小技巧 - 04。
日常生活中，我們一定常看到如下圖的資料樣式
這種資料一般是提供給 人 來看了，但它卻不合適給電腦或人來做資料數據的處理。
所以，常會有需要將跨欄置中的效果，加以去除！
並且，將其下方的空白儲存格，加以填滿資料的要求。
結果如下：
你知道，要如何完成這樣的需求嗎？
| 去除跨欄置中 |
手動方式：先選取要處理的資料範圍 1-4欄，常用／跨欄置中 下，取消合併儲存格
程式控管：
Range("A:D").Select
ActiveWindow.SmallScroll Down:=6
Selection.UnMerge
| 自動填補空白內容 |
手動方式：注意，只選取要處理的資料範圍(如：A5~D28)，常用／尋找與選取 下，到(G)。
系統會幫你找到被選取範圍中的第一個空值儲存格：A6，此時，需要在該儲存格中登打填補空格資料的來源，如：A6資料是來自至A5。
所以，要打入 =A5 等字樣，並按下 【Ctrl + Enter】，好將所有的空格填滿。
程式控管：
' 在特定區域中尋找 空值 儲存格，並加以填入 上一格儲存格 的內容
Selection.SpecialCells(xlCellTypeBlanks).Select
ActiveWindow.SmallScroll Down:=-9
Selection.FormulaR1C1 = "=R[-1]C"
在 VBA 中，寄送郵件–OutLook 用法
先前介紹過“在 VBA 中，寄送 GMail 郵件”，現在來說下，要如何使用 OutLook 來寄送郵件。
一樣照抄程式碼，稍加改點內容即可。
Sub Mail2SZ_Click()
Dim objOutlook As Object
Dim objMail As Object
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
objMail.To = "PertonChang@gmail.com"
objMail.Subject = "Forecast"
objMail.Body = "FYI" & vbCrLf & "Shalom!"
objMail.Attachments.Add "D:\GitHub\Videos.zip" ' 添加附件檔案
' objMail.Display ' 可以編輯郵件內容，再按下 傳送 鍵。
' objMail.Save ' to save a copy in the drafts folder
objMail.Send ' 直接送出郵件
Set objOutlook = Nothing
Set objMail = Nothing
End Sub
在 VBA 中，寄送 GMail 郵件
想要使用 VBA 來寄送 GMail 郵件，就要應用到 CDO(Collaboration Data Objects) 的功能。但是實務上的使用，就算是不知道什麼是 CDO？
也可以輕鬆應用它來寄送郵件。
以下是網路既有的函數，程式指令直接照抄，只要修正部分指令內容即可。（有加上底色的區域）
Private Function fSendGmail() As Boolean 'Returns True if No Errors are Generated
On Error GoTo Err_ErrorHandler
fSendGmail = True
'Extract
'The SendMail() Function
'While longer, SendMail( ) is itself a simpler function than GetData( ) . It simply creates three
'objects: CDO. Message, CDO. Configuration, and a subobject of CDO. Configuration called
'Fields . The Scripting library used in GetData() is a default part of the ASP namespace, and
'therefore any new object created in the Scripting library is known. To use objects in the CDO
'library, the METADATA statements at the top of the ASP page are necessary.
'Standard CDO Constants
'NOTE --- If you set conCdoSmtpUseSSL to True, you may need to set conCdoSendUsingPort to 465 or port number specified by your ISP.
Const conStrPrefix As String = "http://schemas.microsoft.com/cdo/configuration/"
Const conCdoSendUsingPort As Integer = 2 'If incorrect raises this Error: -2147220960
Const conCdoBasic As Integer = 1
Const conStrSmtpServer As String = "smtp.gmail.com" 'If incorrect raises this Error: -2147220973
Const conCdoSmtpUseSSL As Boolean = True 'Use Secure Sockets Layer (SSL) when posting via SMTP.
Const conCdoSmtpServerPort As Integer = 465 'Can be 465 or 587 'If incorrect raises this Error: -2147220973
Const conSendUserName As String = "pertonchang@gmail.com"
Const conSendPassword As String = "**********"
Dim oMsg As Object
Dim oConf As Object
Dim strEmailAddr As String
strEmailAddr = "pertonchang@gmail.com"
'Create Objects
Set oMsg = CreateObject("CDO.Message")
Set oConf = CreateObject("CDO.Configuration")
Set oMsg.Configuration = oConf
'Build the Message
With oMsg
.To = "Testing <" & strEmailAddr & ">"
.From = "From TextBox <pertonchang@gmail.com>" 'If incorrect raises this Error: -2147220973
.Subject = "From Keyed in Email Address"
.TextBody = "From Keyed in Email Address"
.AddAttachment "H:\GoogleEmail\TransscriptGmailFromVBA.txt"
End With
''Set Delivery Options
With oConf.Fields
.Item(conStrPrefix & "sendusing") = conCdoSendUsingPort
.Item(conStrPrefix & "smtpserver") = conStrSmtpServer
.Item(conStrPrefix & "smtpauthenticate") = conCdoBasic
.Item(conStrPrefix & "sendusername") = conSendUserName
.Item(conStrPrefix & "sendpassword") = conSendPassword
.Item(conStrPrefix & "smtpusessl") = conCdoSmtpUseSSL
.Item(conStrPrefix & "smtpserverport") = conCdoSmtpServerPort
.Update 'Commit Changes
End With
'Deliver the Message
oMsg.send
Exit_ErrorHandler:
'Access 2007 Developer Reference > Microsoft Data Access Objects (DAO) Reference > DAO Reference > Recordset Object > Methods
'An alternative to the Close method is to set the value of an object variable to Nothing (Set dbsTemp = Nothing).
Set oMsg.Configuration = Nothing
Set oConf = Nothing
Set oMsg = Nothing
Exit Function
Err_ErrorHandler:
If Err.Number <> 0 Then fSendGmail = False
Select Case Err.Number
Case -2147220977 'Likely cause, Incorrectly Formatted Email Address, server rejected the Email Format
MsgBox "Error From --- fSendGmail --- Incorrectly Formatted Email --- Error Number >>> " _
& Err.Number & " Error Desc >> " & Err.Description, , "Format the Email Address Correctly"
Case -2147220980 'Likely cause, No Recipient Provided (No Email Address)
MsgBox "Error From --- fSendGmail --- No Email Address --- Error Number >>> " _
& Err.Number & " Error Desc >> " & Err.Description, , "You Need to Provide an Email Address"
Case -2147220960 'Likely cause, SendUsing Configuration Error
MsgBox "Error From --- fSendGmail --- The SendUsing configuration value is invalid --- LOOK HERE >>> sendusing) = conCdoSendUsingPort --- Error Number >>> " _
& Err.Number & " Error Desc >> " & Err.Description, , "SendUsing Configuration Error"
Case -2147220973 'Likely cause, No Internet Connection
MsgBox "Error From --- fSendGmail --- No Internet Connection --- Error Number >>> " _
& Err.Number & " Error Desc >> " & Err.Description, , "No Internet Connection"
Case -2147220975 'Likely cause, Incorrect Password
MsgBox "Error From --- fSendGmail --- Incorrect Password --- Error Number >>> " _
& Err.Number & " Error Desc >> " & Err.Description, , "Incorrect Password"
Case Else 'Report Other Errors
MsgBox "Error From --- fSendGmail --- Error Number >>> " & Err.Number _
& " <<< Error Description >> " & Err.Description
End Select
Resume Exit_ErrorHandler
End Function 'fSendGmail
Excel VBA 的小技巧 - 03
有幾個指令在程式自動化中，可以善加運用，好增進程式的運作效能及美觀。
Application.ScreenUpdating = False ' turn off the screen updating
Application.ScreenUpdating = True ' turn on the screen updating
ActiveWindow.FreezePanes = True
ActiveWindow.FreezePanes = False
Application.DisplayAlerts = False
Application.DisplayAlerts = True
之前【Excel VBA 的小技巧 - 02】文章提到，要在不同的活頁簿中切換，可用 Activate 來處理，好切換到指定名稱的活頁簿。
例如：
從現在使用中的活頁簿，切換到 Excel3 的 Sheet2
Workbooks("Excel3").Sheets("Sheet2").Activate
從現在使用中的活頁簿，切換到 Excel1 的 Sheet1
Workbooks("Excel1").Sheets("Sheet1").Activate
若是，切換不同活頁簿的過程中，沒有特別要切換到不同的工作表，那麽可以用 Windows().Activate 來簡化。
Windows(strExcelSource).Activate
Excel VBA 的小技巧 - 02
上一篇文章【Excel VBA 的小技巧 - 01】提到如何用 陣列 動態宣告的方式，來創建新的 Excel 活頁簿檔案。
原本以為新的 Excel 活頁簿檔案建立後，就可以直接讀取舊有檔案資料，好回寫到新檔案裡面。不料，原本可以讀到舊檔案資料的指令，在執行過創建新 Excel 活頁簿檔案指令後，既然變成失效！
解決方法：需要事先將現行活頁簿、工作表的資訊記錄下來，並且要在創建新 Excel 活頁簿檔案後，再將先前記錄下來的訊息，加以激活。(作用起來)
Dim SourceWB as String
Dim SourceSH as String
SourceWB = ActiveWorkbook.Name
SourceSH = ActiveSheet.Name
ReDim NewBook(intRow): Set NewBook(intRow) = Workbooks.Add
Workbooks(SourceWB).Sheets(SourceSH).Activate
接下來，談一個 Excel 太聰明所造成的困擾。
你若是在儲存格打入字串 001，這時 Excel 會自動的轉換成數字 1。我想這樣的經驗大家應該都會遇到。
解決方案：改變要登打資料的儲存格格式，從通用格式該成為文字格式。
程式碼處理，則是 NumberFormatLocal = "@" NewBook(pCnt).Sheets(1).Cells(pRowCnt, "G").NumberFormatLocal = "@"
NewBook(pCnt).Sheets(1).Cells(pRowCnt, "G") = "001"
使用 Excel 時，常會選擇一個區域的範圍，並按下 Delete 鍵來清除該範圍中的資料。所以改用程式處理時，也就會下 Delete 指令，如此卻得到不正確地結果。應該下 ClearContents。 Rows("4:65536").Select
Selection.ClearContents
Excel VBA 的小技巧 - 01
在使用 Excel VBA 的功能中，有幾個常用的程式指令，需要清楚該指令的功效！
Application.Path => C:\Program Files\Microsoft Office 15\root\office15
ActiveWorkbook.Path => D:\GitHub\_Misc\訂單
ActiveWorkbook.Name => Excel 活頁簿的名稱
ActiveSheet.Name => Sheet1 or 料號 等工作表的名稱
ActiveCell().Row => 目前操作中儲存格的Row值，例如：D3儲存格，就得到 3。
ActiveCell().Column => 目前操作中儲存格的Column值，例如：D3儲存格，就得到 4(D Column)。
Cells(3, "D") => 可以得到 D3儲存格的內容值。
Cells(3, 4) => 可以得到 D3儲存格的內容值。
Range("D3") => 可以得到 D3儲存格的內容值。
在同一個活頁簿中，可以用 Activate 來切換到指定名稱的工作表。
例如：從 Sheet1 要切換到 Sheet3
Sheets("Sheet3").Activate
若是要在不同的活頁簿中切換，也是用 Activate 來處理，以便切換到指定名稱的活頁簿。
例如：從 Excel1 的 Sheet1 要切換到 Excel3 的 Sheet2
Workbooks("Excel3").Sheets("Sheet2").Activate
要創建新的 Excel 檔案，可使用 Workbooks.Add、Workbooks.SaveAs
以下是範例演示：
strTarget = Format(Now(), "YYYYMMDD") & "_" & Format(Time(), "hhmmss")
strTargetFile = ActiveWorkbook.Path & "\" & strTarget & ".xlsx"
Set NewBook = Workbooks.Add
NewBook.Sheets(1).Cells(3, "C") = "asdgf"
' NewBook.Title = "All Sales"
' NewBook.Subject = "Sales"
NewBook.SaveAs strTargetFile
NewBook.Close
要同時建制多個活頁簿，可以應用 陣列、動態宣告的方式，來優化程式碼。
ReDim NewBook(intRow): Set NewBook(intRow) = Workbooks.Add
Workbooks(SourceWB).Sheets("Data-天河").Activate
有時候，動態宣告需要保留先前已宣告的內容，就要配合 Preserve。
ReDim strCustNo(1): strCustNo(1) = "AAA"
ReDim Preserve strCustNo(2): strCustNo(2) = "BBB"
談電子資料交換(EDI)基礎技術的對照：文字檔的讀取
現今電腦使用極為平凡，網路上的資料又是多如洋海，景然像是個大數據(Big Data)時代。
若要資料互通，彼此連結，就常常會應用電子資料交換的技術；好讓工作順暢，也可以節省人力、時間。
一般來說，電子資料交換最常使用文字檔格式(也稱作文本檔) *.txt。這類型的檔案，只要滑鼠點擊兩下，就可以被 NotePad 給開啟。(Windows 的默認設定)
但很多人可能不會注意到，這個被開啟的檔案是被儲存成什麼編碼格式？例如：ANSI、Unicode、Unicode big endian、UTF-8。
你可以使用各式文書編輯軟體，來看看他們是什麼編碼格式。
例如：用 NotePad++ 可以看到 
你若是用 NotePad，就會看到 
電子資料交換的應用，一般是以程式方式來處理。方法有 Input/Output、File System Object、ADODB.Stream。
The File System Object, generally used by VBScript devlopers to read and write text files, can read only ASCII or Unicode text files. You cannot use it to read or write UTF-8 encoded text files.
But, if you can use Microsoft ActiveX Data Objects (ADO), you can read UTF-8 encoded text files
File System Object 常被使用在 VBScript 的開發上，可用以讀／寫 ASCII或Unicode 格式的文本檔。但 File System Object 不能用存取 UTF-8 編碼的檔案。
所以，你能使用 Microsoft ActiveX Data Objects (ADO) 才能讀取 UTF-8 編碼的檔案。
以下是兩種類型的程式對比條列，方便有需求者參考。
Dim strFile As String | Dim strFile As String |
API 檢視員(DLL 函式宣告文字的取用)
你可以使用 Visual Basic 程式語言所提供的各項控制項、函式及指令，來完成你所需要的功能。
但是若要作系統操作、應用及控制，則顯得不足許多。這時就需要借助 DLL(Dynamic Link Library)動鍊結函式庫的功能來完成。
DLL 通稱為 Windows API。
使用DLL之前，要先對要引用到的函式名稱，加以宣告，之後才可以叫用該函式。
如：
Public Declare Sub GetSystemTime Lib "kernel32" Alias "GetSystemTime" (lpSystemTime As SYSTEMTIME)
Public Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
只不過 Window API 函式的數量繁多，相對函式的宣告內容，是不可能被記起來。
為此，有安裝 Visual Basic 程式的環境，就有提供一工具程式：API 檢視員 (APILoad.exe) 
宣告文字就可以在此複製，再貼到相關程式設計的環境中。
API查詢：
1.Windows API Reference for C#, VB.NET and VB6
http://www.webtropy.com/articles/Win32-API-DllImport-art9.asp
2.Microsoft Win32 to Microsoft .NET Framework API Map
http://msdn.microsoft.com/en-us/library/aa302340.aspx
大批量超連結的資料，要如何截取其連結網址？
如題，要將含有超連結(HyperLink)的文字，萃取出它的超連結網址，這是一個超連結的”反向工程”。
在 Excel 中，要設定一串文字，使其具有超連結的作用，可以用
1. 手動操作設定
2. 配合 Excel 公式 設定
反之，若是要取得相關超連結的網址，可能就要用 VBA 才能完成。
但是，並不是每個人都懂 VBA，那該如何處理呢 !!
相關函數寫好後，再設計一個按鈕，給操作者使用。
只要按下 [產生 超連結 資料] 按鈕，相關 連結網址 資料，就可以正確取得。是不是很方便呀 !!
在 Excel 中，要設定一串文字，使其具有超連結的作用，可以用
1. 手動操作設定
2. 配合 Excel 公式 設定
反之，若是要取得相關超連結的網址，可能就要用 VBA 才能完成。
但是，並不是每個人都懂 VBA，那該如何處理呢 !!
1: Sub link()
2: Dim i As Integer
3: Dim DataRows As Integer
4:
5: Cells(1, 1).Select
6: Selection.End(xlDown).Select
7: DataRows = ActiveCell.Row()
8:
9: i = 1
10: Do While i <= DataRows
11: Cells(i, 2) = Cells(i, 1).Hyperlinks(1).Address
12:
13: i = i + 1
14: Loop
15: End Sub
相關函數寫好後，再設計一個按鈕，給操作者使用。
只要按下 [產生 超連結 資料] 按鈕，相關 連結網址 資料，就可以正確取得。是不是很方便呀 !!
初識 XML 的結構
假設，有一 XML 檔案(MENU_CHT.xml) 內容如下：
-----------------------------------------------------------
<?xml version="1.0" encoding="utf-8"?>
<MENU>
<A prgkey="BA" caption="基礎工程" enable="true">
<A1 prgkey="PB" caption="公用資料" enable="true">
…
</A1>
</A>
… (含 A 元素，共有 21個子元素)
-----------------------------------------------------------
使用 VBA 程式來讀取，各式指令將取得不同的結果值，要注意哦
Set XMLDoc = New MSXML2.DOMDocument
strFileXML = ActiveWorkbook.Path & "\" & "MENU_CHT.xml"
intState = XMLDoc.Load(strFileXML) ' intState 數值說明; (-1) 成功
If intState Then 'MsgBox "讀取 XML 成功"
Set xFirst = XMLDoc.FirstChild
' MsgBox xFirst.nodeName ==> xml
'
Set xRoot = XMLDoc.documentElement
' MsgBox xRoot.nodeName ==> MENU
' MsgBox XMLDoc.childNodes ==> 2
' MsgBox xRoot.childNodes ==> 21
For i = 1 To Level1nodes.Length
' 取得元素內容
Set Level1node = Level1nodes.NextNode
' MsgBox Level1node.nodeName
' 取得屬性內容
Set Level1Attr = Level1node.Attributes
'MsgBox Level1Attr.Length
For a = 1 To Level1Attr.Length
Set nodeAttr = Level1Attr.Item(a - 1)
' MsgBox nodeAttr.nodeName & " -- " & nodeAttr.Text
' nodeAttr.nodeName ==> prgkey
' nodeAttr.Text ==> BA
strAttr = strAttr & nodeAttr.Text & vbTab
Next
Next i
VBS 為Excel 資料自動排序的用法
想要用VBS 為Excel 資料自動排序，需要注意到幾個重點：
- 要排序的 Excel 檔名，不可含有中文字
- 要為排序資料事先建立 範圍名稱(Range Name)
- 範圍名稱(Range Name)也不可以使用中文字
- VBS 程式中，要注意到 objRange.Sort 函式的使用語法及參數位置
以範例說明如下：
ERP_Sort_公告編號_A_Q.vbs
-----------------------------------------------------------
Const xlAscending = 1
Const xlYes = 1
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
Set objWorkbook = objExcel.Workbooks.Open("C:\ERP\ERP_On-Line_Notice.xls")
' Worksheets 編號由 1起算
Set objWorksheet = objWorkbook.Worksheets(4)
Set objRange = objWorksheet.UsedRange
Set objRange2 = objExcel.Range("AnnounceNo")
Set objRange3 = objExcel.Range("A")
Set objRange4 = objExcel.Range("Q")
objRange.Sort objRange2, xlAscending, objRange3, , xlAscending, objRange4, xlAscending, xlYes
------------------------------------------------------------
資料參考：Tips and Tricks for Scripting Microsoft Office Applications
Excel VBA 中如何下複製公式的指令語法？
平時在 Excel中，只要在要複製儲存格的右下角，點兩下，就可以複製該儲存格的公式到其他位置。
若要以程式來操作，可以下指令：
Range("I3").Select
Selection.AutoFill Destination:=Range("I3:I24")
Range("I3:I24").Select
但是，若要動態取得被複製的範圍，這時就要宣告變數來處理
Dim mRanges As String
Range("H3").Select
mRanges = "I3:" & "I" & Selection.End(xlDown).Row
Range("I3").Select
Selection.AutoFill Destination:=Range(mRanges)
Range(mRanges).Select
注意：指令語法中，首、尾各有一個 Range().Select 指令，不可少。
VBA讀取XML檔案內容
book.xml
-----------------------------------
<?xml version="1.0" encoding="UTF-8" ?>
<!-- ?xml:stylesheet type="text/css" href="20-5.css" -->
<order>
<name>Jong Chen</name>
<product>個人電腦</product>
<product>PDA</product>
<price>50000</price>
<date>2011/08/08</date>
<address>台北市安和路二段80號15樓</address>
</order>
-------------------------------------
若是要使用程式來開啟這檔案，該如何寫程式？
Public Sub Load_XML()
Dim XMLDoc As Object
Dim intState As Integer
Dim strFileXML As String
strFileXML = "C:\Documents and Settings\perton\DestTop\XML\" & "book.xml"
Set XMLDoc = New MSXML2.DOMDocument
intState = XMLDoc.Load(strFileXML)
' intState 數值說明
' -1 成功
' 0 未初始化
' 1 載入中
' 2 已載入
' 3 互動
' 4 已完成
If intState Then
MsgBox "讀取 XML 成功"
Else
MsgBox "讀取 XML 失敗"
End If
Set XMLDoc = Nothing
End Sub
** 在程式環境中，要加入 Reference ：Microsoft XML, v5.0
VBA 中，該如何將文字內容寫入文字檔案？
VBA 中，該如何將文字內容寫入文字檔案？
以範例說明會比較實用：
Dim FileNumber As Integer
Dim strFile As String
FileNumber = FreeFile()
Open strPath & "\" & strFileName For Output As #FileNumber
Print #FileNumber, "<html>"
Print #FileNumber, "<head>"
Print #FileNumber, " <meta http-equiv=""Content-Language"" content=""zh-tw"">"
Print #FileNumber, " <meta http-equiv=""Content-Type"" content=""text/html; charset=big5"">"
Print #FileNumber, " <title>" + frm上傳檔案資料.Form.file_namec + "</title>"
Print #FileNumber, "</head>"
Print #FileNumber, ""
Print #FileNumber, "<body>"
Print #FileNumber, "</body>"
Print #FileNumber, "</html>"
Close #FileNumber
產生一個不能正常開啟的 XML 檔案 (2)
在先前"產生一個不能正常開啟的 XML 檔案 (1)" 文章中提到，即使已經產生 Unicode 格式的 XML 檔案。
但是，也無法正常被開啟。
原因是檔案是 UTF-16LE，不是我們所需要的 UTF-8 格式。
要解決這問題，就需要改用 ADO Stream ，而不用 FileSystemObject 。
Write2XML_ADO Stream.vbs
-----------------------------------------------------
Dim oFile
Dim sStr
oFile = "C:\Write_ADO Stream.XML"
sStr = "<?xml version = " & Chr(34) & "1.0" & Chr(34) & " encoding = " & _
Chr(34) & "UTF-8" & Chr(34) & " ?>" & vbCrlf
sStr = sStr & "<book>" & vbCrlf
sStr = sStr & "</book>" & vbCrlf
Set objADODBStream = CreateObject("ADODB.Stream")
objADODBStream.Charset = "UTF-8"
objADODBStream.Open
objADODBStream.WriteText sStr
objADODBStream.SaveToFile oFile, 2
objADODBStream.Close
Set objADODBStream = Nothing
WScript.Echo "C:\Write_ADO Stream.XML be Created"
產生一個不能正常開啟的 XML 檔案 (1)
學習 VBScript 過程中，記得有一程式是要產生 XML 檔案。
程式運作後，檔案是產生了，但是卻無法正常開啟。
Write2XML.vbs
-------------------------
Const ForReading = 1, ForWriting = 2, TristateTrue = -1, TristateOff = 0
Dim oFSO,oFile,strg,re
Dim sStr
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFile = oFSO.OpenTextFile("C:\Write.XML", ForWriting, True, TristateTrue)
sStr = "<?xml version = " & Chr(34) & "1.0" & Chr(34) & " encoding = " & _
Chr(34) & "UTF-8" & Chr(34) & " ?>" & vbCrlf
sStr = sStr & "<book>" & vbCrlf
sStr = sStr & "</book>" & vbCrlf
oFile.WriteLine sStr
WScript.Echo "C:\Write.XML be Created"
oFile.Close
Set oFile = Nothing
這程式使用的參數 TristateTrue 來產生 Unicode 檔案，但是此時的 Unicode 是 UTF-16 LE，而不是 UTF-8。
所以，就無法以點擊滑鼠兩次的方式來開啟該 XML 檔案。
訂閱：
文章 (Atom)