关于清空Office的剪切板（三）_ExcelFans

查看文章

关于清空Office的剪切板（三）

2008-04-26 18:13

第二部分代码：

    '|--------------------------------------------------|
    '|-----------以下部分用于取得剪切板窗口句柄---------|
    '|--------------------------------------------------|

    '/--取得Office程序的主窗体句柄
     hMain = Application.hwnd

    '/假如Excel版本是2000及其以下版本
     hVersion = Application.Version
    If hVersion < 10 Then MsgBox "此程序不支持Excel2000及其以下版本": Exit Sub

    '/假如Excel版本为2007版且剪切板不可见时使其可见
    If hVersion = 12 Then
         bClip = True
        With Application.CommandBars("Office Clipboard")
            If Not .Visible Then
                 LockWindowUpdate hMain
                 bClip = False
                Set octl = Application.CommandBars(1).FindControl(ID:=809, recursive:=True)
                If Not octl Is Nothing Then octl.Execute
            End If
        End With
    End If

    '/用于取得剪切板窗口的句柄（剪切板窗口可见时）
    Do
          hExcel2 = FindWindowEx(hMain, hExcel2, "EXCEL2", vbNullString)
          hParent = hExcel2: hWindow = 0
          hWindow = FindWindowEx(hParent, hWindow, "MsoCommandBar", vbNullString)
        If hWindow Then
              hParent = hWindow: hWindow = 0
              hWindow = FindWindowEx(hParent, hWindow, "MsoWorkPane", vbNullString)
            If hWindow Then
                  hParent = hWindow: hWindow = 0
                  hClip = FindWindowEx(hParent, hWindow, "bosa_sdm_XL9", "Collect and Paste 2.0")
                If hClip > 0 Then
                    Exit Do
                End If
            End If
        End If
    Loop While hExcel2 > 0
    '/取得剪切板窗口的句柄（剪切板窗口不可见时,2003及XP版本调用）
    If hClip = 0 Then
          hParent = hMain: hWindow = 0
          hWindow = FindWindowEx(hParent, hWindow, "MsoWorkPane", vbNullString)
        If hWindow Then
              hParent = hWindow: hWindow = 0
              hClip = FindWindowEx(hParent, hWindow, "bosa_sdm_XL9", "Collect and Paste 2.0")
        End If
    End If
    '/取得剪切板窗口的句柄（剪切板窗口未初始化,2003及XP版本调用）
    If hClip = 0 Then
        With Application.CommandBars("Task Pane")
            If Not .Visible Then
                 LockWindowUpdate hMain
                Set octl = Application.CommandBars(1).FindControl(ID:=809, recursive:=True)
                If Not octl Is Nothing Then octl.Execute
                 .Visible = False
                 LockWindowUpdate 0
            End If
        End With
         hParent = hMain: hWindow = 0
         hWindow = FindWindowEx(hParent, hWindow, "MsoWorkPane", vbNullString)
        If hWindow Then
              hParent = hWindow: hWindow = 0
              hClip = FindWindowEx(hParent, hWindow, "bosa_sdm_XL9", "Collect and Paste 2.0")
        End If
    End If
    '/即如以上都未找到剪切板窗口，显示错误信息
    If hClip = 0 Then
        MsgBox "剪切板窗口未找到"
        Exit Sub
    End If


    '|--------------------------------------------------|
    '|------以下部分用于取得"全部清空"按钮并执行它------|
    '|--------------------------------------------------|

    '以下部分代码参考了《Advanced Microsoft Visual Basic 6.0 Second Edition》第16章Microsoft Active Accessibility部分
    '定义IAccessible对象的GUID{618736E0-3C3D-11CF-810C-00AA00389B71}
    With tg
         .lData1 = &H618736E0
         .nData2 = &H3C3D
         .nData3 = &H11CF
         .abytData4(0) = &H81
         .abytData4(1) = &HC
         .abytData4(2) = &H0
         .abytData4(3) = &HAA
         .abytData4(4) = &H0
         .abytData4(5) = &H38
         .abytData4(6) = &H9B
         .abytData4(7) = &H71
    End With
    '/从窗体返回Accessible对象
     lReturn = AccessibleObjectFromWindow(hClip, 0, tg, oIA)
     lStart = 0
    '/取得Accessible的子对象数量
     lHowMany = oIA.accChildCount
    ReDim avKids(lHowMany - 1) As Variant
     lGotHowMany = 0
    '/返回Accessible的子对象
     lReturn = AccessibleChildren(oIA, lStart, lHowMany, avKids(0), lGotHowMany)
    For i = 0 To lGotHowMany - 1
        If IsObject(avKids(i)) = True Then
            If avKids(i).accName = "Collect and Paste 2.0" Then
                Set oNewIA = avKids(i)
                 lHowMany = oNewIA.accChildCount
                Exit For
            End If
        End If
    Next i
    ReDim avMoreKids(lHowMany - 1) As Variant
     lReturn = AccessibleChildren(oNewIA, lStart, lHowMany, avMoreKids(0), lGotHowMany)
    '取得"全部清空"按钮并执行它
    For i = 0 To lHowMany - 1
        If IsObject(avMoreKids(i)) = False Then
            If oNewIA.accName(avMoreKids(i)) = "全部清空" And oNewIA.accRole(avMoreKids(i)) = ROLE_PUSHBUTTON Then
                 oNewIA.accDoDefaultAction (avMoreKids(i))
                Exit For
            End If
        End If
    Next i

    '/如果原来Excel版本为12且剪切板不可见则恢复它
    If hVersion = 12 And bClip = False Then Application.CommandBars("Office Clipboard").Visible = bClip: LockWindowUpdate 0

End Sub

这个代码的原理是首先找到Office剪切板的句柄，然后通过Microsoft Active Accessibility来取得“全部清空”按钮并执行它，从而清空了剪切板。这也就避免了前面第3种方法的局限性。

以上言论纯属抛砖引玉，那位大侠有更好的办法望共享。

备注：今天发现原来的代码不支持Excel2007版，所以对代码作了一定的修改，使其可以支持清空2007版Excel的剪切板了。------wangminbai 2008-4-26

类别：excel杂记|

|添加到搜藏 |分享到i贴吧|浏览(1702)|评论 (0)

姓　名：	*姓名最长为50字节

网址或邮箱：	(选填)

内　容：

	取消回复