我在excel中工具-》插入-》由文件创建方法插入一个视频，如何禁止用户拖动这个视频文件，让他固定位置。

Question

换句话说用户拖动shape触发什么事件？我怎样禁止用户拖动shape。但选择单元格还是让选的。

Answer 1

阿门，突然想起来excel有保护工作表的功能。你将允许用户编辑的区域设为1:65536，然后在启用保护工作表的对话框中不要选择 编辑对象 

Answer 2

使用保护表功能的话，如果我这个shape是个视频文件还能点击播放么？
另外，在excel上点击shape在vba里触发什么事件了？请楼上高手赐教

Answer 3

选择“大小和位置固定”不管用，还是可以拖动此shape

Answer 4

我是这样做的：
'在ThisWorkbook模块中： 
Private Sub Workbook_Open() 
Dim b As Shape 
For Each b In ThisWorkbook.ActiveSheet.Shapes 
    b.OnAction = "test" 
Next 
End Sub '在“模块1”中： 
Public Sub test() 
    MsgBox TypeName(Selection) 
End Sub 可是在test中的selection不是用户点击的shape。怎么解决？

Answer 5

Private Sub Workbook_Open()
    Dim b As Shape
    For Each b In ThisWorkbook.ActiveSheet.Shapes
        b.OnAction = "'ThisWorkbook.Test """ & b.Name & """'"
    Next
End SubSub Test(objName)
    Dim sht As Worksheet
    Set sht = ActiveSheet
    With sht.Shapes(objName)
        If MsgBox("是否打开对象 """ & objName & """", vbYesNo) = vbYes Then
            .OLEFormat.Verb (xlVerbPrimary)
        End If
    End With
End Sub

Answer 6

非常感谢，不过还有一个问题，我是在vb中控制excel的，onaction后面怎么写能调用我vb中的一个子程序？解决了马上就给分。呵呵。

Answer 7

想了个DDE的办法供你参考
打开工程的属性,将“生成”选项卡将应用程序标题设为“MyApp”：Option Explicit
Dim oExcel As Excel.Application
Dim oWorksheet As WorksheetPrivate Const LINK_TOPIC_STR As String = "FORM_DDE_SINK"
Private Sub Command1_Click()
    Set oExcel = New Application
    oExcel.Visible = True
    Set oWorksheet = oExcel.Workbooks.Open(App.Path & "\book1.xls").Sheets(1)
End SubPrivate Sub Form_LinkExecute(CmdStr As String, Cancel As Integer)
    On Error Resume Next
    Set oWorksheet = oExcel.ActiveSheet
    With oWorksheet.Shapes(CmdStr)
        MsgBox "你点击了对象" & CmdStr
    End With
End SubPrivate Sub Form_Load()
    With Me
        .LinkMode = 0
        .LinkTopic = LINK_TOPIC_STR
        .LinkMode = 1
    End With
End SubExcel里面的宏改成这样：Private Const APP_NAME_STR As String = "MyApp"
Private Const LINK_TOPIC_STR As String = "FORM_DDE_SINK"Private Sub Workbook_Open()
    Dim b As Shape
    For Each b In ThisWorkbook.ActiveSheet.Shapes
        b.OnAction = "'ThisWorkbook.Test """ & b.Name & """'"
    Next
End SubSub Test(objName As String)
    SendDDEMessage objName
    Exit Sub
    Dim sht As Worksheet
    Set sht = ActiveSheet
    With sht.Shapes(objName)
        If MsgBox("是否打开对象 """ & objName & """", vbYesNo) = vbYes Then
            .OLEFormat.Verb (xlVerbPrimary)
        End If
    End With
End SubSub SendDDEMessage(objName As String)
    On Error Resume Next
    Dim lChannel As Long
    lChannel = Application.DDEInitiate(APP_NAME_STR, LINK_TOPIC_STR)
    If lChannel <> 0 Then
        Application.DDEExecute lChannel, objName
        Application.DDETerminate lChannel
    End If
End Sub

Answer 8

非常感谢超级绿豆的赐教，给出了一个非常好的交互方法，但是在我的程序中，excel表都是通过用户选择打开的，表里我不可能写进去程序，所以我想实现把上面代码中需要写到excel表中的也都写到vb中，当然onaction我可以在vb中当excel打开时赋给每个shape指定宏。
我现在解决的方法是：在用户机器上应用加载宏的方式（就是在xlstart中建立xla文件），把指定宏的内容写到加载宏中，让每个shape指定宏都调用xla里的子程序。这样虽然不是很好，但是能解决我目前的问题。
如果不用xla文件都写在vb中，那就完美了，请问高手有没有更好的办法。

Answer 9

不用xla，超级绿豆的代码都可以在vb实现，可以在用户打开excel文件以后，把要执行的宏从vb写入用户文件就行了。

Answer 10

Private Sub oExcel_WorkbookOpen(ByVal Wb As Excel.Workbook)
    Dim sCodes As String
    
    sCodes = ""
    sCodes = sCodes & vbCrLf & "Sub Test(objName As String)"
    sCodes = sCodes & vbCrLf & "    SendDDEMessage objName"
    sCodes = sCodes & vbCrLf & "End Sub"
    sCodes = sCodes & vbCrLf & ""
    sCodes = sCodes & vbCrLf & "Sub SendDDEMessage(objName As String)"
    sCodes = sCodes & vbCrLf & "    On Error Resume Next"
    sCodes = sCodes & vbCrLf & "    Dim lChannel As Long"
    sCodes = sCodes & vbCrLf & "    lChannel = Application.DDEInitiate(""" & APP_NAME_STR & """, """ & LINK_TOPIC_STR & """)"
    sCodes = sCodes & vbCrLf & "    If lChannel <> 0 Then"
    sCodes = sCodes & vbCrLf & "        Application.DDEExecute lChannel, objName"
    sCodes = sCodes & vbCrLf & "        Application.DDETerminate lChannel"
    sCodes = sCodes & vbCrLf & "    End If"
    sCodes = sCodes & vbCrLf & "End Sub"    With Wb.VBProject.VBComponents("ThisWorkbook").CodeModule
        .InsertLines .CountOfLines + 1, sCodes
    End With
End Sub