Oscar Sun on SnipSave | Web-based code snippet manager for developers

書名號篇名號檢查，校對用

View Snippet

                    Sub 書名號篇名號檢查()
Dim s As Long, rng As Range, e, trm As String, ans
Static x() As String, i As Integer
On Error GoTo eH
Do
    Selection.Find.Execute "〈", , , , , , True, wdFindAsk
    Set rng = Selection.Range
    rng.MoveEndUntil "〉"
    trm = Mid(rng, 2)
    
    For Each e In x()
        If StrComp(e, trm) = 0 Then GoTo 1
    Next e
2   ans = MsgBox("是否略過「" & trm & "」？" & vbCr & vbCr & vbCr & "結束請按 NO[否]", vbExclamation + vbYesNoCancel)
    Select Case ans
        Case vbYes
            ReDim Preserve x(i) As String
            x(i) = trm
            i = i + 1
        Case vbNo
            Exit Sub
    End Select
1
Loop
Exit Sub
eH:
Select Case Err.Number
    Case 92 '沒有設定 For 迴圈的初始值 陣列尚未有值
        GoTo 2
End Select
End Sub

若要使用 Windows API 呼叫將資訊傳送到剪貼簿，請將以下程式碼貼入標準模組的 [宣告] 區段中。

View Snippet

                    Option Explicit
Private Declare Function OpenClipboard Lib "user32.dll" (ByVal hWnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32.dll" () As Long
Private Declare Function CloseClipboard Lib "user32.dll" () As Long
Private Declare Function IsClipboardFormatAvailable Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function GetClipboardData Lib "user32.dll" (ByVal wFormat As Long) As Long
Private Declare Function SetClipboardData Lib "user32.dll" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function lstrcpy Lib "kernel32.dll" Alias "lstrcpyW" (ByVal lpString1 As Long, ByVal lpString2 As Long) As Long

Public Sub SetClipboard(sUniText As String)
    Dim iStrPtr As Long
    Dim iLen As Long
    Dim iLock As Long
    Const GMEM_MOVEABLE As Long = &H2
    Const GMEM_ZEROINIT As Long = &H40
    Const CF_UNICODETEXT As Long = &HD
    OpenClipboard 0&
    EmptyClipboard
    iLen = LenB(sUniText) + 2&
    iStrPtr = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, iLen)
    iLock = GlobalLock(iStrPtr)
    lstrcpy iLock, StrPtr(sUniText)
    GlobalUnlock iStrPtr
    SetClipboardData CF_UNICODETEXT, iStrPtr
    CloseClipboard
End Sub

Public Function GetClipboard() As String
    Dim iStrPtr As Long
    Dim iLen As Long
    Dim iLock As Long
    Dim sUniText As String
    Const CF_UNICODETEXT As Long = 13&
    OpenClipboard 0&
    If IsClipboardFormatAvailable(CF_UNICODETEXT) Then
        iStrPtr = GetClipboardData(CF_UNICODETEXT)
        If iStrPtr Then
            iLock = GlobalLock(iStrPtr)
            iLen = GlobalSize(iStrPtr)
            sUniText = String$(iLen \ 2& - 1&, vbNullChar)
            lstrcpy StrPtr(sUniText), iLock
            GlobalUnlock iStrPtr
        End If
        GetClipboard = sUniText
    End If
    CloseClipboard
End Function

'https://msdn.microsoft.com/zh-tw/library/office/ff192913.aspx

若要使用 API 呼叫從剪貼簿擷取資訊，請將以下程式碼貼入標準模組的宣告區段中。

View Snippet

                    Declare Function OpenClipboard Lib "User32" (ByVal hwnd As Long) _ 
   As Long 
Declare Function CloseClipboard Lib "User32" () As Long 
Declare Function GetClipboardData Lib "User32" (ByVal wFormat As _ 
   Long) As Long 
Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags&, ByVal _ 
   dwBytes As Long) As Long 
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) _ 
   As Long 
Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) _ 
   As Long 
Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) _ 
   As Long 
Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, _ 
   ByVal lpString2 As Any) As Long 
 
Public Const GHND = &H42 
Public Const CF_TEXT = 1 
Public Const MAXSIZE = 4096

'將以下程式碼貼入標準模組中。
Function ClipBoard_GetData() 
   Dim hClipMemory As Long 
   Dim lpClipMemory As Long 
   Dim MyString As String 
   Dim RetVal As Long 
 
   If OpenClipboard(0&) = 0 Then 
      MsgBox "Cannot open Clipboard. Another app. may have it open" 
      Exit Function 
   End If 
          
   ' Obtain the handle to the global memory 
   ' block that is referencing the text. 
   hClipMemory = GetClipboardData(CF_TEXT) 
   If IsNull(hClipMemory) Then 
      MsgBox "Could not allocate memory" 
      GoTo OutOfHere 
   End If 
 
   ' Lock Clipboard memory so we can reference 
   ' the actual data string. 
   lpClipMemory = GlobalLock(hClipMemory) 
 
   If Not IsNull(lpClipMemory) Then 
      MyString = Space$(MAXSIZE) 
      RetVal = lstrcpy(MyString, lpClipMemory) 
      RetVal = GlobalUnlock(hClipMemory) 
       
      ' Peel off the null terminating character. 
      MyString = Mid(MyString, 1, InStr(1, MyString, Chr$(0), 0) - 1) 
   Else 
      MsgBox "Could not lock memory to copy string from." 
   End If 
 
OutOfHere: 
 
   RetVal = CloseClipboard() 
   ClipBoard_GetData = MyString 
 
End Function
'https://msdn.microsoft.com/zh-tw/library/office/ff194373.aspx

剪貼簿功能，是Windows內建的功能之一，而VBA可透過DataObject來進行存取，以下利用幾個程式來介紹要如何撰寫。

View Snippet

                    例如我的工作表裡面的內容如下圖：



工作表我已框選A1:B4的範圍，並複製起來

此時，執行以下程式：

Sub Day22_取得剪貼簿內容()
    Dim data As New DataObject
    Dim strData  As String

    data.GetFromClipboard
    strData = data.GetText(1)

    Debug.Print strData
End Sub
此程式收集了剪貼簿的內容後，貼到即時運算視窗內，在該視窗將會呈現：



第二個程式，資料如同第一個程式，但為收集A2:A4範圍內的資料，然後寫入剪貼簿中，再用PasteSpecial方法貼到除存格中。

Sub Day22_寫入剪貼簿()
    Dim data As New DataObject
    Dim strData As String
    
    For Each Rng In Range("A2:B4")
        strData = strData & Rng
    Next
    
    data.SetText strData '寫入DataObject
    data.PutInClipboard  '寫入剪貼簿
    
    '同Range("D1").PasteSpecial xlPasteAll
    [D1].PasteSpecial xlPasteAll
End Sub
這裡要提到的是，[D1]這樣的寫法，看起來更簡單，寫起來也方便，但我不是很推薦，若你寫的程式需要再多國語言狀態下使用，有些語系的似乎是不支援，但如果都在同樣語系下使用，就沒什麼差別。

以下為呈現出來的結果：



以下是透過SetText方法塞入空值，達到清除剪貼簿的目的。

Sub Day22_清除剪貼簿內容()
    Dim data As New DataObject
    Set data = New DataObject
    data.SetText ""
    data.PutInClipboard
End Sub
若你有大量資料需要重別處複製過來，但須加工後才能使用，那可以試著用這方法，將剪貼簿內容取出後，透過程式處理完，再貼到特定位置，達到更有效率的目的，以上分享，希望對各位有所助益。

http://ithelp.ithome.com.tw/articles/10159745

如何在控制外部程式的視窗元件(FindWindow, SendMessage)

View Snippet

                    .Introduction
        
        在開發程式中, 當碰到底層功能沒開放出來的時候, 往往最後只能在外部控制介面來處理,舉個例子, 像是碰到比較特殊的硬體裝置, 而廠商沒提供driver的原始碼, sdk的功能不完整等等問題之類的, 在只有官方的控制用應用程式的情況下, 此時也就只能寫外部程式直接來控制,以下論述實作方式.



        首先, 如下圖, 拿一個列印介面來當例子, 主要步驟有兩個部分, 首先要先取得視窗控制元件,在來世更進一步的做控制.

列印程式介面



I. Get Window HWND
        
        要取得一個windows的控制權, 首先要取得該視窗的HWND, 實作上可以使用FindWindow函式, 詳細可以看msdn.

FindWindow:
        http://msdn.microsoft.com/en-us/library/windows/desktop/ms633499%28v=vs.85%29.aspx

        由函式的定義來看, 可以指定的參數有兩個, 一個是class名稱, 指定控制元件的類別,此部分不給也可以, 但是要防止碰到名稱一樣的控制元件,第二個是控制元件名稱, 以這個例子就是"列印", 程式碼如下
?
1
2
3
4
5
HWND wnd = FindWindow( NULL, "列印");
if(wnd)
{
    //處理    
}


II.對視窗做控制
     
        在視窗的控制方面, 有兩種方式, 以下個別做說明
如果可以確定元件id的話, 可以Send WM_COMMAND做處理
抓到最底層目標的原件, 直接送訊息

1.WM_COMMAND
        在這邊特別說明一下 WM_COMMAND, 當我們在做視窗操作時, 像是按下按鈕, 下拉選單等等, 都會觸發WM_COMMAND, 如果知道操作對象的話,某種程度直接使用WM_COMMAND就可以處理了, 詳細可以看msdn


WM_COMMAND:       
        http://msdn.microsoft.com/en-us/library/windows/desktop/ms647591%28v=vs.85%29.aspx


WM_COMMAND的訊息有三種方式
Menu
Accelerator
Control

其中Accelerator不討論,這邊看menu以及Control的方式

.WM_COMMAND - Menu
       
        實際測試了一下, 按鈕的話照menu方式直接送ID也有BN_CLICKED的效果,非按鈕的我就不確定了, 程式碼如下.

?
1
SendMessage(wnd, WM_COMMAND, IDOK, NULL);

        參考程式碼頁面,照定義送的是menu元件的話, 則wParam的高位元會是0, 低位元是id, 其實等同IDOK(送高位元放0, 低位元IDOK), 如果怕判斷會出問題的話, 可以用MAKEWPARAM即可

?
1
2
3
4
5
6
7
WPARAM MAKEWPARAM(
  WORD wLow,
  WORD wHigh
);
 
WPARAM wParam = MAKEWPARAM( IDC_OK, 0);
SendMessage(wnd, WM_COMMAND, MAKEWPARAM(IDOK,0),0);

.WM_COMMAND - Control

        Control的方式較複雜, 以下是msdn的定義
wParam
        高位元放Control-defined notification code       
        低位元放Control identifier
lParam
        Handle to the control window
      
        此例已知控制視窗的wnd, 所以處理wParam即可

?
1
SendMessage(wnd, WM_COMMAND, MAKEWPARAM(IDOK,BN_CLICKED),0);

2.抓最底層目標元件

        目前已取得目標視窗的HWND, 要在更進一步找視窗裡面的元件時, 需要使用FindWindowEX來處理, 使用方式一樣是由名稱找, 這邊範例指定class名稱, 名稱定義詳細可以看msdn, 這邊就不詳述了, 程式碼如下


?
1
2
3
HWND wndButton = FindWindowEx(wnd, NULL,"Button", "取消");;
 
SendMessage(wndButton, BM_CLICK, 0, 0);


III.實作程式碼


?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
void main()
{
    HWND wnd = FindWindow( NULL, "列印");
    if(wnd)
    {    
 
        //方式1..知道元件ID的話可以用, 
        //物件是按鈕的話,直接送ID也可以達到Click的效果
        //另外, 如果真的不確定id,
        //IDOK(1)通常會是windows預設介面的"確定",IDCANCEL同
     
        //menu方式
        SendMessage(wnd, WM_COMMAND, IDOK, NULL);
        SendMessage(wnd, WM_COMMAND, MAKEWPARAM(IDOK,0),0);
     
        //Control方式
        SendMessage(wnd, WM_COMMAND, MAKEWPARAM(IDOK,BN_CLICKED),0);
     
     
        //方式2, 進一步取得按鈕, 送出按下訊息
        HWND wndButton = FindWindowEx(wnd, NULL,"Button", "取消");//"列印(&P)");
        if(wndButton)
        {
            SendMessage(wndButton, BM_CLICK, 0, 0);
        }
     
     }
}


http://arkkk.blogspot.tw/2011/11/findwindow-sendmessage.html