| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 1649 人关注过本帖
标题:请问一下各位老师~~我这段代码存在什么问题,为什么点击按钮之后无反应~
只看楼主 加入收藏
Hjfvb6
Rank: 1
等 级:新手上路
帖 子:7
专家分:0
注 册:2021-5-21
结帖率:0
收藏
已结贴  问题点数:20 回复次数:3 
请问一下各位老师~~我这段代码存在什么问题,为什么点击按钮之后无反应~
Implements IDTExtensibility2
Option Explicit
Private WithEvents objButton1 As
Public xlApp As Excel.Application
Private Sub IDTExtensibility2_OnConnection(ByVal Application As Object, ByVal ConnectMode As AddInDesignerObjects.ext_ConnectMode, ByVal AddInInst As Object, custom() As Variant)
  Set xlApp = Application
  CreateMenus
End Sub
Private Sub IDTExtensibility2_OnDisconnection(ByVal RemoveMode As AddInDesignerObjects.ext_DisconnectMode, custom() As Variant)
End Sub
Private Sub IDTExtensibility2_OnAddInsUpdate(custom() As Variant)
End Sub
Private Sub IDTExtensibility2_OnBeginShutdown(custom() As Variant)
End Sub
Private Sub IDTExtensibility2_OnStartupComplete(custom() As Variant)
End Sub
Private Sub IDTExtensibility_OnStartupComplete(custom() As Variant)
End Sub
Private Sub CreateMenus() '创建自定义工具栏
    On Error Resume Next
    ("Worksheet Menu Bar").Controls("自定义工具(&K)").Delete
  With ("Worksheet Menu Bar").Controls.Add(Type:=msoControlPopup, Before:=11)  '创建一个新工具栏
        .Caption = "自定义工具(&K)"
        .Style = msoButtonIconAndCaption
    Set objButton1 = .Controls.Add(Type:=msoControlButton) '创建按钮
    With objButton1 '引用子菜单
      .Caption = "分离" '设置菜单的显示文字
      .Style = msoButtonIconAndCaption '同时显示文字与图标
      .FaceId = 310 '指定图标
    End With
    xlApp.ScreenUpdating = True
    .Visible = True
  End With
End Sub

Public Sub objButton1_Click(ByVal Ctrl As , CancelDefault As Boolean)
    分离
End Sub
Public Sub 分离()
xlApp.ScreenUpdating = False
On Error Resume Next  '忽略错误继续执行VBA代码,避免出现错误消息
  Dim n As Integer     
Dim arr As Variant     
Dim rcount As Long   
Dim ArrayLength As Integer
Dim l As String         
Dim m As String      
Dim r, i
  With xlApp.ActiveSheet
  l = xlApp.InputBox("请输入要分离的是哪一列", "确定参数对话框", "请输入", 2500, 3500)
  If l <> "请输入" Then
  Debug.Print "输入值为:" + l
  End If
  m = xlApp.InputBox("请输入分割的符号", "确定参数对话框", "请输入", 2500, 3500)   
  If m <> "请输入" Then     
  Debug.Print "输入值为:" + m
  End If
 rcount = xlApp.Cells(xlApp.Rows.Count, l).End(3).Row
 For r = rcount To 1 Step -1
 arr = Split(xlApp.Cells(r, l).Value, m)
 ArrayLength = UBound(arr) - LBound(arr) + 1
 For i = 1 To ArrayLength - 1
               xlApp.Rows(r & ":" & r).Copy
              xlApp.Rows(r + 1 & ":" & r + 1).Insert Shift:=xlDown     
      Next i
       xlApp.Cells(r, l).Resize(ArrayLength, 1).Value = xlApp.WorksheetFunction.Transpose(arr)
      Erase arr      
  Next r
   xlApp.CutCopyMode = False         
End With
xlApp.ScreenUpdating = True
End Sub




搜索更多相关主题的帖子: Dim 输入 Private End Sub 
2021-05-21 17:17
HVB6
Rank: 7Rank: 7Rank: 7
等 级:贵宾
威 望:15
帖 子:331
专家分:561
注 册:2013-10-30
收藏
得分:10 
回复 楼主 Hjfvb6
VB6调用Excel
http://club.
(出处: ExcelHome技术论坛)
2021-05-22 11:33
Hjfvb6
Rank: 1
等 级:新手上路
帖 子:7
专家分:0
注 册:2021-5-21
收藏
得分:0 
回复 2楼 HVB6
我发现问题了,是窗体显示不出来,我可以输入,但是没有窗体,inputbox的窗体不显示,请问您知道是什么原因吗
2021-05-24 11:48
cwa9958
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:76
帖 子:278
专家分:1357
注 册:2006-6-25
收藏
得分:10 
去掉On Error Resume Next试试看
2021-05-24 16:38
快速回复:请问一下各位老师~~我这段代码存在什么问题,为什么点击按钮之后无反应 ...
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.017757 second(s), 10 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved