ExcelVBA Win窗口开发散点图

基于VBA编写的一款界面化的数据导入分析处理，软件原创归属CDamogu 和https://m-todo.com,未经允许不得转载

声明:由于某种历史原因,该方案未被采纳,且该软件由本人业余时间独立完成,现仅作学习分享使用

软件需求

试验台数据保存格式为txt，数据包含12列数据，从中提取位移和角度两列数据的第一个循环（一个极限到另外一个极限）进行后续计算。通过软件选择txt文件后，点击计算按钮，输出计算结果（全行程间隙）和曲线，图表要求如下：

1. 图表尺寸8cm（宽）*6cm（高）
2. 图表内容要求如下：

• 横坐标是角度 横坐标默认范围是-600°～600°

• 纵坐标是位移 纵坐标默认范围是-0.02～0.1mm

• 蓝色线条txt中原始数据的位移
  

• 红色线条位移是加上中位间隙后的修正位移

3. 曲线名称分别为YC on centre和YC maximum
4. 图表标题为Yoke travel vs Pinion angle

原始数据

假设原始数据如下述格式排序：

输出位移 输出负荷左 输出负荷右 输入扭角 输入扭矩N.m 供油压力MPa 回油压力MPa 流量 时间s 温度 计数 扭角速度
-0.001 -6466.000 -8601.000 471.40500 5.15200 -15.019 1.543 0.000 15.97201 0.0 2 29.821
-0.003 -6466.000 -8601.000 470.26100 0.56933 -15.019 1.543 0.000 16.02201 0.0 2 29.821
-0.005 -6466.000 -8601.000 468.91900 -0.60433 -15.019 1.543 0.000 16.07201 0.0 2 29.821
-0.005 -6466.000 -8601.000 467.43400 -0.62300 -15.019 1.543 0.000 16.12201 0.0 2 29.821
-0.004 -6466.000 -8601.000 466.03700 -0.87967 -15.019 1.543 0.000 16.17201 0.0 2 29.821
1
2
3
4
5
6

开发思路

对于上述信息我们不关心他是要干什么的，要明白我们需要做什么。

1. 首先我们需要做的是一个散点图表，通过两列数据，每一行的两个数构成了一个点。
2. Excel能够帮助我们快速将Txt数据导入，并且迅速提取出我们需要的两列数据
   • 我们要取值的是其中某两列的值，那么我们就要提取出来该两列的值
   • 数据的格式是用一个空格来分开，那么这就为后续提取数据提供帮助
   • 我们要做的是散点分布图，但是上图数据来看数据并不是按照递增的方式排序，那么后续需要排序
3. 通过新建一个工作簿将两列数据筛选出来进行后续处理
4. 对两列数据进行图表生成

总体界面布局

1. 我想要的效果是打开Excel的瞬间弹出来的是窗体，不再显示表格界面
2. 如果需要浏览后台的详细操作，需要提供相应权限
3. 这么做的好处就是，由于VBA代码很多是与表格相挂钩的，如果被不懂的人拿去使用有可能会乱动你的表格导致代码无法执行，或者计算错误
4. 对于使用者来说稳定和可靠是必须的，所以仅仅会使用而不改变表格内布局也是必不可少的。

'Thisworkbook
Private Sub Workbook_Open()
    Application.Visible = False
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    UserForm1.Show vbModeless
End Sub
1
2
3
4
5
6
7

后台管理布局

'UserForm1代码
'调试界面，管理员，调出登录窗口
Private Sub BTN_LOGIN_Click()
    UserForm2.Show vbModeless
End Sub

'UserForm2代码
'调试按钮，进入后台
Private Sub WIN_DEV_LOGIN_BTN_Click()
    If WIN_DEV_PASSWORD_TB.Text = "" Then   '此处定义你的密码
        Application.Visible = True
        Application.DisplayAlerts = True
        Application.ScreenUpdating = True
        'UserForm2.Hide                  '登录成功，隐藏
        Unload Me                       '窗体执行完成后，释放内存
    Else
        MsgBox ("密码错误")
    End If
End Sub
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19

退出按钮释放后台

大多时候，VBA窗口关闭并不会清除该Excel后台，那么在运行过程中占用进程的东西，当你去删除的时候会告诉你被占用无法删除，这点很烦人。

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
        Dim WB As Workbook
        For Each WB In Workbooks
            If WB.Name <> ThisWorkbook.Name Then WB.Close False
        Next WB
        ThisWorkbook.Saved = True
        Application.Quit
        Unload Me '释放窗体内存
End Sub
1
2
3
4
5
6
7
8
9

屏幕刷新

屏幕刷新的理解就是：当你关闭刷新时候，你的窗体很多信息并不会实时显示，除非此时你刷新屏幕后才会在窗体显示。

• 代码中LB_ResultStatus是一个Listbox的控件，用于在屏幕中展示当前操作状态，借用代码时候记得调整。

Private Sub OP_Screen_Close_Click()
    With Application
        .ScreenUpdating = False
    End With


    LB_ResultStatus.AddItem "已关闭屏幕刷新模式"        '屏幕刷新      'LB_ResultStatus为ListBox控件，用于显示操作状态
End Sub

Private Sub OP_Screen_Open_Click()
    With Application
        .ScreenUpdating = True
    End With


    LB_ResultStatus.AddItem "已切换屏幕刷新模式"        '屏幕刷新      'LB_ResultStatus为ListBox控件，用于显示操作状态
End Sub
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17

自动计算与手动计算

为什么要用到自动计算与手动计算，Excel默认是自动计算。

• 当你多表格协同工作时候，因为很多表格内的函数在同时互相调用sheets的数据，如果你输入的数据量很大，会输入一个数据其余所有表格的函数计算一次，那么当你输入足够多的时候，会计算足够多的次数，经常遇到的问题是Excel卡崩溃或者电脑死机。
• 那么首先切换到手动计算（非自动计算），当数据导入完成后，再次切换到自动计算，通过一遍完成所有函数。
• 代码中LB_ResultStatus是一个Listbox的控件，用于在屏幕中展示当前操作状态，借用代码时候记得调整。

Private Sub OP_Cal_Manual_Click()
        With Application
        .Calculation = xlManual
         End With


         LB_ResultStatus.AddItem "已切换手动计算"            '手动计算     'LB_ResultStatus为ListBox控件，用于显示操作状态
End Sub
Private Sub OP_Cal_Automatic_Click()
'-> 切换计算方式，将系统刚开始设置的手动计算切换成自动计算，实现其余函数对该表格的调用
        With Application
        .Calculation = xlAutomatic
        End With


        LB_ResultStatus.AddItem "已切换自动计算"            '自动计算      'LB_ResultStatus为ListBox控件，用于显示操作状态
End Sub
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17

网页访问（帮助与支持）

Private Sub CommandButton1_Click()
    With CreateObject("internetexplorer.application")
        .Visible = True
        .Navigate "https://www.baidu.com"
        '关闭网页
        '       .Quit
    End With

    LB_ResultStatus.AddItem "[完成]跳转访问http://www.m-todo.com"         'LB_ResultStatus为ListBox控件，用于显示操作状态
End Sub
1
2
3
4
5
6
7
8
9
10

软件有效期设计

'窗体事件初始化程序-固定的函数
Private Sub UserForm_Initialize()
    Call TimeManager
End Sub

'时间管理
Sub TimeManager()
    If DateDiff("d", DateSerial(2020, 11, 19), Date) >= 300 Then
        MsgBox "此文件试用期限为300天，目前您的使用期限已到，请联系开发者！", 48, "温馨提醒您："
        Application.DisplayAlerts = False
        With ThisWorkbook
        .Saved = True
        .ChangeFileAccess xlReadOnly
        Kill .fullName
        .Close
        End With
        Application.DisplayAlerts = True
    Else
        Exit Sub
    End If
End Sub
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

获取文件

    'Global Variable
    '打开文件对话框返回的文件名，是一个全路径文件名，其值也可能是False，因此类型为Variant
    Dim fullName As String
    Dim fileName As String                         '从FileName中提取的路径名

    'Function 定义
    '绑定控件Textbox、commandButton
    Private Sub ReadFile_Click()

        Dim fileNameObj As Variant
        Dim aFile As Variant                            '数组，提取文件名fileName时使用

        Dim i As Integer

        fileNameObj = Application.GetOpenFilename("Excel 文件 (*.txt),*.txt")     '调用Windows打开文件对话框
        If fileNameObj <> False Then                   '如果未按"取消"键
            aFile = Split(fileNameObj, "\")            '通过"\"分割元素
            fileName = aFile(UBound(aFile))            '数组的最后一个元素为文件名
            fullName = aFile(0)                        
            For i = 1 To UBound(aFile)                 '循环合成全路径
                fullName = fullName & "\" & aFile(i)
            Next
        Else
            MsgBox "请选择文件"
            End
        End If


        '得到Excel全路径
        TB_SelFile = fullName                               'TB_SelFile为Textbox控件，用于显示路径
        LB_ResultStatus.AddItem "路径已载入" & TB_SelFile    'LB_ResultStatus为ListBox控件，用于显示操作状态
    End Sub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33

导入数据

对于该段代码，可以通过录制宏来实现，通过录制宏去导入数据，然后获取代码，当然，下面这一段代码并不能满足要求，手动修改一部分。

Private Sub BTN_LoadData_Click()
    '载入数据之前应该先清除历史存在的数据再进行导入，此处是清除名为"INPUT"的工作簿的数据
    Worksheets("INPUT").UsedRange.ClearContents   
    '禁止粘贴复制      
    Application.CutCopyMode = False
    Sheets("INPUT").Select   '选择工作表导入，细节(避免后续程序bug)(由于我们界面上操作，导入数据前一定要切换到你想要下述代码在哪个工作簿中执行)

    '[录制宏生成]从指定位置读取了文件并放在了指定位置。（由于不满足要求，我们需要将我们获取文件的路径跟此处拼接，所以有了下面这一段）
    'With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Users\Han Dong\Desktop\cesh\CJ26S3-01#-2020_9_25_14_58数据.txt", _
        Destination:=Range("$A$1"))
        '.CommandType = 0
        '.Name = "CJ26S3-01#-2020_9_25_14_58数据"

    '[大蘑菇修改]修改上述方法为可变地址
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & fullName, _
        Destination:=Range("$A$1"))         '指定的位置，此处是从A1开始放，$绝对引用
        '.CommandType = 0
        .Name = fileName

        '[录制宏生成]具体什么意思就不讲了
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 936
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = True
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Range("N19").Select
    ActiveWindow.SmallScroll Down:=-21
    Range("P13").Select    


    LB_ResultStatus.AddItem "数据已导入" & fileName            'LB_ResultStatus为ListBox控件，用于显示操作状态
End Sub
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53

复制指定列数据(筛选)

'处理筛选指定序列数据
Private Sub BTN_ChooseTargetData_Click()
    Sheets("INPUT").Select                '切换到工作簿"INPUT"中
    Range("A:A,D:D").Select               '选择范围A列、D列
    Range("D1").Activate
    Selection.Copy                        '复制所选
    Sheets("处理").Select                 '切换到工作簿"处理"中
    Columns("A:A").Select                 '选择A列
    ActiveSheet.Paste                     '粘贴

    LB_ResultStatus.AddItem "已完成数据筛选，排序方式：默认"     'LB_ResultStatus为ListBox控件，用于显示操作状态
End Sub
1
2
3
4
5
6
7
8
9
10
11
12

Textbox与表格之间数值的交互

Private Sub TB_Center1_Change()
    '首先如果要将Textbox的值传递给Excel表并使其为数值类型，那么需要通过Val()转换
    Worksheets("处理").Range("H6").Value = Val(TB_Center1.Text)     'TB_Center1为Textbox控件

    '如果要将Excel表中的值传递给Textbox,需要将表中的值变为text传递给控件
    TB_FullPath = Worksheets("处理").Range("N13").Text              'TB_FullPath为Textbox控件
End Sub
1
2
3
4
5
6
7

Image控件将生成的图表显示

Private Sub BTN_UpdateData_Click()
    Sheets("处理").Select       '细节，避免程序崩溃

    Dim strPath$
    Dim jpg1$

    'ThisWorkbook.Path & "\LiuwanqiangRocovery.bat"   '路径拼接示例

    strPath = Environ$("Temp") & Application.PathSeparator
    jpg1 = strPath & "jpg1.jpg"

    ActiveSheet.ChartObjects(1).Select                '先选中图表1，不然以下设置会出错
    ActiveSheet.ChartObjects(1).Chart.Export jpg1     'fileName:=jpg1

    With Me.Pic_Chart                                 'Pic_Chart为Image控件
        .PictureSizeMode = fmPictureSizeModeZoom
        .Picture = LoadPicture(jpg1)
        .AutoSize = Ture
    End With

    LB_ResultStatus.AddItem "[完成]图表已更新"         'LB_ResultStatus为ListBox控件，用于显示操作状态
End Sub
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

图片导出

'保存图表
Private Sub BTN_SaveChart_Click()
    Sheets("处理").Select       '细节，避免程序崩溃(决定你的代码在哪个工作表中执行)    

    ActiveSheet.ChartObjects(1).Select  '先选中图表，不然以下设置会出错
    ActiveSheet.ChartObjects(1).Chart.Export ThisWorkbook.Path & "\Target.png"             '生成的位置是你Excel文件所在的地方，名为Target.png


    LB_ResultStatus.AddItem "文件已生成，查看详情" & ThisWorkbook.Path & "\Target-Ford.png"       'LB_ResultStatus为ListBox控件，用于显示操作状态
End Sub
1
2
3
4
5
6
7
8
9
10

通过CMD运行某文件

Private Sub BTN_ViewChart_Click()
     Shell "cmd.exe /k cd/d " & ThisWorkbook.Path & "\&&Target.png", vbHide            '此处例子是通过CMD打开了当前工作簿路径下的图片
End Sub
1
2
3

获取某列数据行数，通过VBA代码给单元格引用函数

1. 首先我导入了一个txt，但是每组数据列数是一定的，但是行数是不定的
2. 如果我在程序中将行数写死，那么如果一旦导入数据超过该阈值，软件一定会崩溃
3. 那么如何动态获取导入的数据的行数，并将其用在代码中？

Private Sub BTN_UpdatePandingLine_Click()
     Sheets("处理").Select                        '细节，避免程序崩溃
     iRow = Range("a65536").End(xlUp).Row         '获取a列数据行数
     Range(Cells(2, 4), Cells(iRow, 4)).Select    '动态选择某个范围的值   此处解读：（第二行，第四列） - （iRow行，第四列）这个范围
     'FormulaR1C1是公式输入方法  R:行 C：列
     '[]中括号表示的是相对于选定单元格的相对偏移量，（负数）- 表示向左或向上偏移      （正数）+ 表示向右或者向下
     'R1C1表示A1单元格  R5C6表示F5
     '假如选定单元格C8    R[-1]C[-1]表示B7单元格   R[1]C[2]表示E9单元格

     '选择的列是4，那么R13C[4]就是H13,这里的意思就说选取第四列（2-N行）所有单元格，引用函数=R13C[4]（说白了就说赋值）
     Selection.FormulaR1C1 = "=R13C[4]"           
End Sub
1
2
3
4
5
6
7
8
9
10
11
12

效果展示

Following me now !

git clone https://gitee.com/liuwanqiang/scatter-diagram-with-vba.git
1