小程序练习

OKJSJSF

改为最多连续九列插图　　　Sub cb4(control As IRibbonControl)
    If MsgBox("在当前工作表全选匹配内容（如序列号、证件号、型号之类）所在单元格区域、再单击待插图区域首列任一单元格，把名称一致的图批量导入工作表的连续的一至九列格子中，图的大小位置随格子。注意事项：" & Chr(10) & "1、所有待插图先集中保存在一个文件夹中；2、图须完善命名，同行第二至第九个图命名时，约定在图名称右边依次增加　半角“-2、-3、-4、……、-9”，格式为最常用的 .jpg。" & Chr(10) & "如果不用本功能，请单击“取消”或“X”。", vbOKCancel + vbInformation, "功能说明：") <> vbOK Then Exit Sub
    If TypeName(Selection) <> "Range" Then Cells(1).Select
    Dim i As Byte, idran As Range, inran As Range, shapepath As String
    On Error GoTo errline
    i = InputBox("请在下框输录 数字 来确定图插成几列：" & Chr(10) & "1、一列；2、二列；……；9、九列。", "数据设置：", 1)
    If i > 9 Or i < 1 Then
        MsgBox "设置不可用。", , "微软的提醒："
        Exit Sub
    End If
    Set idran = Application.InputBox("请全选匹配内容所在单元格区域：", "数据设置2：", , , , , , 8)
    Set inran = Application.InputBox("请选择待插图区域首列任一单元格：", "数据设置3：", , , , , , 8)
    With Application.FileDialog(FileDialogtype:=msoFileDialogFolderPicker)
        .Title = "请“双击”打开各文件夹，最后“双击”或“单击”图所在文件夹后，单击“确定”。"
        If .Show = -1 Then
            shapepath = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    shapepath = shapepath & IIf(Right(shapepath, 1) = "\", "", "\")
    Dim n As Byte, myran As Range, fulnam As String, ml As Double, mt As Double, mw As Double, mh As Double, mysha As Shape
    On Error Resume Next
    Application.ScreenUpdating = False
    For Each myran In idran
        If Not IsEmpty(myran) Then
            If i = 1 Then
                fulnam = shapepath & myran.Value & ".jpg"
                ml = myran.Offset(0, inran.Column - myran.Column).Left
                mt = myran.Offset(0, inran.Column - myran.Column).Top
                mw = myran.Offset(0, inran.Column - myran.Column).Width
                mh = myran.Offset(0, inran.Column - myran.Column).Height
                Set mysha = ActiveSheet.Shapes.AddPicture(Filename:=fulnam, LinkToFile:=msoTrue, SaveWithDocument:=msoTrue, Left:=ml, Top:=mt, Width:=mw, Height:=mh).Select
            Else
                fulnam = shapepath & myran.Value & ".jpg"
                ml = myran.Offset(0, inran.Column - myran.Column).Left
                mt = myran.Offset(0, inran.Column - myran.Column).Top
                mw = myran.Offset(0, inran.Column - myran.Column).Width
                mh = myran.Offset(0, inran.Column - myran.Column).Height
                Set mysha = ActiveSheet.Shapes.AddPicture(Filename:=fulnam, LinkToFile:=msoTrue, SaveWithDocument:=msoTrue, Left:=ml, Top:=mt, Width:=mw, Height:=mh).Select
                For n = 2 To i
                    fulnam = shapepath & myran.Value & "-" & n & ".jpg"
                    ml = myran.Offset(0, inran.Column - myran.Column + n - 1).Left
                    mt = myran.Offset(0, inran.Column - myran.Column + n - 1).Top
                    mw = myran.Offset(0, inran.Column - myran.Column + n - 1).Width
                    mh = myran.Offset(0, inran.Column - myran.Column + n - 1).Height
                    Set mysha = ActiveSheet.Shapes.AddPicture(Filename:=fulnam, LinkToFile:=msoTrue, SaveWithDocument:=msoTrue, Left:=ml, Top:=mt, Width:=mw, Height:=mh).Select
                Next
            End If
            mysha.Placement = xlMoveAndSize
            mysha.Name = Dir(fulnam)
        End If
    Next
    idran.Item(1).Select
    Application.ScreenUpdating = True
errline:
End Sub

OKJSJSF

现在算基本完工。接下去要学一下字典、正则、类模块，再学Word与EXCEL交互的vba、access

OKJSJSF

刚刚又阅读了老版主的《加载宏制作攻略》，我的小程序中的《去重计数》功能中，粘贴可见选区数据时，不应该新建工作表，而应直接粘在加载宏文件的隐藏的工作表中即可，统计完毕后即删除粘贴的数据。

OKJSJSF

今天耐着性子又解决了一个问题。
在使用“会议助手”功能时，有时“表单控件”命令按钮button不能显示活动单元格的值，而是显示自己的名称“按钮”加数字顺序号。经测试，原来命令按钮的文本长度只能32以内（含）！当单元格中的字符串长度超过32时，会议助手功能就失效了。因为从系统导出至工作表的数据，很多数据都被串连上几十个空格，导致单元格中数据长度超过32。所以程序又必须改动，用trim函数二端去空格。看来，会议助手功能必须增加一项命令供选择，用窗体中的文本框或标签等来显示单元格的值。

OKJSJSF

发现，去重计行数总有差错。在对单元格值首尾去空格后，如果单元格格式为文本，空单元格所在行也总会被计为一行，无法在循环过程中全部删除文本格式的空行。系统自带的的删除重复项计数，也总会把全部空单元格所在行作为一行计数。烦恼啊！

evouren

自己玩得很high,要有前瞻性的才实用，恕我冒昧

OKJSJSF

找到原因。原来COUNTA函数计算真空文本格式单元格时，不等于0，这样的行不会被删。实际工作中的数据表，总有很多列是文本格式的，比如身份证号之类超长度数字，所以，既使所有格子都无数据，COUNTA函数也不会删了它们。这个函数在此用处不行。

OKJSJSF

evouren 发表于 2020-2-20 08:44
自己玩得很high,要有前瞻性的才实用，恕我冒昧

我们单位OFFICE只能上到2007版，而且是2018年11月份才升级的，还有很多网点还没升（2003版），我已到顶了。前瞻是不可能的了。学生已年迈，过几年就退休了。

OKJSJSF

看来要逐行循环，用LEN（  ）= 0 才能删除空行。

OKJSJSF

OKJSJSF 发表于 2020-2-20 13:05
看来要逐行循环，用LEN（  ）= 0 才能删除空行。

晚上，COUNTA（）=O发生作用了，不会把真空文本格式单元格统计为1了。怪