[已解决]关于VBA的“模块未找到” 问题

glhfgtd

我找到了下面代码来清空剪切板的内容，当时很好用，保存文件时，也没出现问题。
可再打开时， 会弹出如下错误提示，然后保存在模块里vba代码全都不见了。
是什么问题呀， 帮帮我！







使用的代码如下：

Option Explicit

Private Declare Function FindWindowEx _
    Lib "user32.dll" _
    Alias "FindWindowExA" ( _
        ByVal hWnd1 As Long, _
        ByVal hWnd2 As Long, ByVal lpsz1 As String, _
        ByVal lpsz2 As String) _
As Long

Private Declare Function AccessibleObjectFromWindow _
    Lib "oleacc" ( _
        ByVal hwnd As Long, _
        ByVal dwId As Long, _
        riid As tGUID, _
        ppvObject As Object) _
As Long

Private Declare Function AccessibleChildren _
    Lib "oleacc" ( _
        ByVal paccContainer As IAccessible, _
        ByVal iChildStart As Long, _
        ByVal cChildren As Long, _
        rgvarChildren As Variant, _
        pcObtained As Long) _
As Long

Private Declare Function LockWindowUpdate _
    Lib "user32" ( _
        ByVal hwndLock As Long) _
As Long

Private Type tGUID
    lData1            As Long
    nData2            As Integer
    nData3            As Integer
    abytData4(0 To 7) As Byte
End Type

Private Const ROLE_PUSHBUTTON = &H2B&

Sub ClearOfficeClipboard()

    Dim hMain        As Long
    Dim hExcel2      As Long
    Dim hClip        As Long
    Dim hWindow      As Long
    Dim hParent      As Long
    Dim lParameter   As Long
    Dim octl         As CommandBarControl
    Dim oIA          As IAccessible
    Dim oNewIA       As IAccessible
    Dim tg           As tGUID
    Dim lReturn      As Long
    Dim lStart       As Long
    Dim avKids()     As Variant
    Dim avMoreKids() As Variant
    Dim lHowMany     As Long
    Dim lGotHowMany  As Long
    Dim bClip        As Boolean
    Dim i            As Long
    Dim hVersion     As Long
   
    hMain = Application.hwnd

    hVersion = Application.Version

    If hVersion < 10 Then MsgBox "此程序不支持Excel2000及以下版本": Exit Sub
   
    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

    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

    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
   
    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

    lReturn = AccessibleObjectFromWindow(hClip, 0, tg, oIA)
    lStart = 0

    lHowMany = oIA.accChildCount
    ReDim avKids(lHowMany - 1) As Variant
    lGotHowMany = 0

    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
    If hVersion = 12 And bClip = False Then Application.CommandBars("Office Clipboard").Visible = bClip: LockWindowUpdate 0
   
End Sub

最佳答案

月排行榜 / 总排行榜

逍遥007

2011-7-31 05:16

你看一下,是不是你的模块的名字,用的是中文的,如果用中文的,有时会有这样的问题.
解决方法,只要把模块改成字母就可以了.

跳转到最佳答案楼层

逍遥007

你看一下,是不是你的模块的名字,用的是中文的,如果用中文的,有时会有这样的问题.
解决方法,只要把模块改成字母就可以了.

glhfgtd

问题真的解决了，看来微软还是有语言兼容的问题呀

keler

是不是真的该成字母鸡可以了