Excel vba 窗体 beforedragover事件怎么用

BeforeDragOver 事件 当拖放 *** 作正在进行时 触发。

有多种窗体控件支持此事件，参数稍有不同。

以下是此事件的一个示例：

1、建立一个窗体，并放置两个 ListBox 控件（ListBox1 和 ListBox2）。

2、为示例方便，设置了 ListBox1 的 RowSource 属性，添加一些数据：

3、编写代码：

Private Sub ListBox2_BeforeDragOver(ByVal Cancel As _

    MSForms.ReturnBoolean, ByVal Data As _

    MSForms.DataObject, ByVal X As Single, _

    ByVal Y As Single, ByVal DragState As Long, _

    ByVal Effect As MSForms.ReturnEffect, _

    ByVal Shift As Integer)

    

    Cancel = True

    Effect = 1

End Sub

Private Sub ListBox2_BeforeDropOrPaste(ByVal _

    Cancel As MSForms.ReturnBoolean, _

    ByVal Action As Long, ByVal Data As _

    MSForms.DataObject, ByVal X As Single, _

    ByVal Y As Single, ByVal Effect As _

    MSForms.ReturnEffect, ByVal Shift As Integer)

    

    Cancel = True

    Effect = 1

    ListBox2.AddItem Data.GetText

    

End Sub

Private Sub ListBox1_MouseMove(ByVal Button As _

     Integer, ByVal Shift As Integer, ByVal X As _

     Single, ByVal Y As Single)

    

    Dim MyDataObject As DataObject

    If Button = 1 Then

        Set MyDataObject = New DataObject

        Dim Effect As Integer

        MyDataObject.SetText ListBox1.Value

        Effect = MyDataObject.StartDrag

    End If

    

End Sub

运行效果如图：

在左边的 ListBox1 某条目上，按下鼠标左键，并拖动到右边的 ListBox2 中：

少了END IF（不过相信不是这个问题）

我觉得程序触发应该不是问题，不管你改动过没有，如果执行Save *** 作一定会触发的。。

问题可能是，修改了工作簿以后，未执行保存的情况下，点击关闭文档，系统会提示是否保存，如果回答不保存当然毫无疑议直接就退出了。。但是如果回答保存的情况下，你的过程被触发但是没能提供正确的密码时，虽然Cancel=True停止了Save的行为，但是没能cancel关闭动作而继续了文档的关闭动作。。。当然，如果这是你的期望结果的话，那就没有任何问题的了。。不过，，如果文档被修改后 *** 作者的原意可能并不想未保存就退出，那你的退出就比较突兀了。

saveas方法不要用在循环里

这个循环是遍历当前工作簿中的所有工作表，并取消保护

而saveas保存的是整个工作簿，不是单个工作表，因此放在循环体中就会多次保存同一个文件，所以会出现“替换”的提示。

由于saveas的文件格式是不带宏的xlsx，因此会提示“删除宏”，可以加一句代码：

application.DisplayAlerts =False

禁止提示窗口即可。

完整代码如下：

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

' 撤消所有工作表的保护

For each sht in Thisworkbook.Worksheets

sht.Unprotect

Next sht

Application.DisplayAlerts = False' 禁止显示提示窗口

MyFilename = "AAA-" &Format(Date, "yymmdd") &".xlsx"

ThisWorkbook.SaveAs Filename:=MyFilename, FileFormat:=xlNormal' 另存为

' 恢复所有工作表的保护

For each sht in Thisworkbook.Worksheets

sht.Protect

Next sht

Application.DisplayAlerts = True' 允许显示提示窗口

End Sub

---