右击菜单创建自己的快捷键，可以有二级菜单，运行自己设计的宏

小丸子gege

各位老师，我自己学的，我很感兴趣，但是论坛我不会发，新人好多权限没有，不知道怎么传数据给你，能不能帮我看下，我做了个
sub 拆分成多表（）这个自制宏，单独运行OK的，然后一般用一个控件超链接这个宏就好了，但是我想右击有一个新建菜单快捷键叫“VBA自制宏（丸子）”，它下一级菜单有这个宏和以后我要加的，但是代码出错了，我也不知道哪儿错了，麻烦帮我看下
Sub 拆分成多表()
'' 拆分成多表 宏
'End Sub   “这个宏单独运行OK的”


“这里开始不行了，没有我想要的效果”
Sub Mycell()
Dim Mycell As CommandBar
On Error Resume Next
Application.CommandBars("Mycell").Delete
    With Application.CommandBars("Mycell").Controls.Add(Type:=msoControlPopup, before:=1, temporary:=False)
        .BeginGroup = True
        .Caption = "VBA自制宏（丸子）"
            With .Controls.Add(Type:=msoControlButton)
              .Caption = "拆分成多表"
              .FaceId = 9590
              .OnAction = "拆分成多表" '拆分成多表 宏,ok
            End With

    End With
    Set Mycell = Nothing
End Sub
Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
   Application.CommandBars("Mycell").ShowPopup
     Cancel = True
End Sub

小丸子gege

麻烦各位老师帮我看下，谢谢啊

小丸子gege

麻烦各位老师帮我看下，谢谢啊

蓝桥玄霜

Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
   Dim Mycell As CommandBar
On Error Resume Next
Application.CommandBars("Mycell").Delete
    With Application.CommandBars("Mycell").Controls.Add(Type:=msoControlPopup, before:=1, temporary:=False)
        .BeginGroup = True
        .Caption = "VBA自制宏（丸子）"
            With .Controls.Add(Type:=msoControlButton)
              .Caption = "拆分成多表"
              .FaceId = 9590
              .OnAction = "拆分成多表" '拆分成多表 宏,ok
            End With
.ShowPopup
    End With

     
End Sub

小丸子gege

蓝桥玄霜 发表于 2018-7-8 15:34
Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
   Dim Myce ...

谢谢蓝老师，我相加你的，但是被限制了，您有别的联系方式么，等您方便的时候我来请教您，我的qq494700595，手机和微信都是15868872226，太谢谢你了，把你的帖子都下载了，打印出来当教材

小丸子gege

蓝桥玄霜 发表于 2018-7-8 15:34
Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
   Dim Myce ...

拆分成多表 宏,突然之间不能用了，我不太知道怎么回事，您帮我改的右击自定义菜单也不能用了，出现下图问题（我希望能运用到所以工作簿）
[img][/img]
[img][/img]
[img][/img]
Sub 拆分成多表()
'
' 拆分成多表 宏
'

Dim ggsht, strdateaddr, ggrg, myvalue1, myvalue2
myvalue1 = CStr(ThisWorkbook.Worksheets("Sheet1").Range("A1").Value)

myvalue2 = CStr(ThisWorkbook.Worksheets("Sheet1").Range("B1").Value)


Set ggsht = Sheets.Add
   ggsht.Name = "结果"
   
   strdateaddr = ThisWorkbook.Worksheets("Sheet1").UsedRange.Address
   
   ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=strdateaddr, Version:=xlPivotTableVersion14).CreatePivotTable _
   TableDestination:=ggsht.Cells(1, 1), Tablename:=myvalue1, DefaultVersion:=xlPivotTableVersion14
   ggsht.Cells(1, 1).Select
   
    With ActiveSheet.PivotTables(myvalue1).PivotFields(myvalue1)
        .Orientation = xlRowField
        .Position = 1
    End With
   
   ActiveSheet.PivotTables(myvalue1).AddDataField ActiveSheet.PivotTables(myvalue1).PivotFields(myvalue2), "计数项:" & myvalue2, xlCount
      
Set ggrg = ggsht.Range("B2")
   Do Until ggrg.Value = ""
   ggrg.ShowDetail = True
   ActiveSheet.Name = ggrg.Offset(0, -1).Value
   ActiveSheet.Columns.AutoFit
   Set ggrg = ggrg.Offset(1, 0)
Loop
End Sub
Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
   Dim Mycell As CommandBar
On Error Resume Next
Application.CommandBars("Mycell").Delete
    With Application.CommandBars("Mycell").Controls.Add(Type:=msoControlPopup, before:=1, temporary:=False)
        .BeginGroup = True
        .Caption = "VBA自制宏（丸子）"
            With .Controls.Add(Type:=msoControlButton)
              .Caption = "拆分成多表"
              .FaceId = 9590
              .OnAction = "拆分成多表"
            End With
.ShowPopup
    End With

     
End Sub

小丸子gege

怎么才能顶上去

小丸子gege

不会上图片也不能上文件，估计要出钱么？提示的问题没有对象和我数据透视表错误，但是我用录制宏的，之前还挺好用，我很郁闷，打击很大，现在不能上传我真的各种无语

小丸子gege

请问，一定要花钱才能解决么，真的就这么浇灭新人那一点点热情