自动插入的button和分配给它的macros不能正常工作

我写的代码自动把button放在需要的地方,并为它指定一个macros:

Sub CreateButton(a, b, c, d As Double, s As String) ActiveSheet.Buttons.Add(a, b, c, d).Select Selection.name = s Selection.OnAction = "Button_ACTION" Selection.Characters.Text = s End Sub 

整个macros如下进行,首先删除表单上的所有button,然后在需要的位置插入button并将macros分配给它:

 Private Sub Button_ACTION() Dim o As Object Dim r, i, c As Integer Set o = ActiveSheet.Buttons(Application.Caller) With o.TopLeftCell r = .Row c = .Column End With ... 

macros确定button的位置并操作数据。 问题是无论我点击哪个button,数据只会在列的第一个点左右。 请告知问题是什么,解决方法是什么?

首先 – 尽量不要使用selection

其次 – 为什么你需要integers ? 使用多头!

你的问题(我认为)是因为你一遍又一遍地给同一个名字,所以用Set o = ActiveSheet.Buttons(Application.Caller)行来select你的第一个button给定的名字!

既然你没有提到你的函数 CreateButton被调用的地方( 以及如何 ),那么只有一种方法可以为我重现你的问题 – 使用相同的s参数调用子多次。

注意:Application.Caller是一个名字为你的情况下的button的string

尝试给一些独特的东西!

 Sub CreateButton(a, b, c, d As Double, s As String) Dim NewButton As Button Static Counter As Long Set NewButton = ActiveSheet.Buttons.Add(a, b, c, d) NewButton.Name = s & Counter NewButton.OnAction = "Button_ACTION" NewButton.Characters.Text = s Counter = Counter + 1 End Sub 

但是我build议你研究你的名字的独特性。 Static计数器是好的,如果你不是一个完美主义者,你很好Long型的限制,所有的button都被删除后退出excel。

我build议你不要期望它 – 当你需要一些独特的东西时,总是使用dictionary

dictionary很容易回答一个问题:“这个string真的是独一无二的吗?”:

 Public Function IsUnique(ByVal str As String) As Boolean Static UniqueDict As New Dictionary If UniqueDict.Exists(str) Then _ Exit Function Call UniqueDict.Add(Key:=str, Item:=str) IsUnique = True End Function 

所以,只有在真正需要的时候,你才可以编辑string或者添加一些东西。 如果在退出时不麻烦删除button – 您可以在启动时填写该字典的名称! 奇妙不是吗?


要使用dictionary对象,您需要参考Microsoft脚本运行时!

问题是你没有独特的button名称。

我改变了你的CreateButton()子,所以它可以取一个名字和一个标题作为参数。 Name是Application.Caller使用的,标题是写在button上的。 名称必须是唯一的,标题可以在所有button上相同。

我还添加了一个检查,以便创build时只接受唯一的button名称。

 Sub test() CreateButton 200, 100, 100, 25, "test1", "Test" CreateButton 50, 50, 100, 25, "test2", "Test" CreateButton 500, 500, 100, 25, "test3", "Test" End Sub Sub CreateButton(left As Double, top As Double, width As Double, height As Double, name As String, caption As String) On Error Resume Next ActiveSheet.Buttons(name).name = name If Err.Number = 0 Then MsgBox "Name has to be unique" Exit Sub End If On Error GoTo 0 'this part above assures that the name for the button is unique. With ActiveSheet.Buttons.Add(left, top, width, height) .name = name .caption = caption .OnAction = "Button_ACTION" End With End Sub 

我强烈build议使用可读的variables名称而不是a,b,c和o!


并意识到这一点

 Dim r, i, c As Integer 'r and i are of type variant here only c is integer CreateButton(a, b, c, d As Double, s As String) 'a, b and c are of type variant. Only d is double and s is string. 

是不一样的

 Dim r As Integer, i As Integer, c As Integer CreateButton(a As Double, b As Double, c As Double, d As Double, s As String) 

为什么你在你的代码上使用Application.Caller …? 它会返callback用者形状对象..? 尝试debugging….我认为Application.Caller将无法返callback用者形状(您的macros分配的形状对象)。 您可以为每个创build的Shapes对象赋予一个唯一的名称,并通过其名称来访问它,这里有个例子希望它有用。

 Option Explicit Public Sub AddButtonWithLoop() Dim btn As Shape 'Use for each loop to Create 3 Shapes, assign name and macro to each Shape Dim i As Integer For i = 1 To 3 Set btn = Worksheets(1).Shapes.AddShape(msoShapeBevel, 10, 70 * i, 70, 50) 'set some properties With btn .Name = "MyButton" & i .TextFrame2.TextRange.Characters.Text = "Button " & i .OnAction = "'SayHello""" & btn.Name & """'" End With Next i End Sub Public Sub SayHello(shapeName As String) 'Create Shape object using ShapeName Dim s As Shape: Set s = ActiveSheet.Shapes(shapeName) With s.TopLeftCell MsgBox .Row MsgBox .Column End With End Sub