全民一起VBA提高篇第八课:图形界面设计二

简单窗体

功能要求:

  1. 能通过窗体显示数据
  2. 能通过窗体添加数据
  3. 能通过窗体修改数据
  4. 能通过窗体删除信息

图片演示效果

显示数据

在这里插入图片描述

添加数据

在这里插入图片描述
在这里插入图片描述

修改数据

在这里插入图片描述

删除数据

在这里插入图片描述

代码实现

在这里插入图片描述
窗体设置,拖动各个控件,并把对应的caption以及名称修改以便后用

在这里插入图片描述
界面中首先添加控件

Sub 显示列表框3()
UserForm3.Show
End Sub

初始化

Private Sub UserForm_Initialize()
    Dim i As Long
    Dim r As Range
   Set r = Worksheets(2).UsedRange
   'worksheets(2)不能忘,这一句用于确定r的范围
   i = r.Row + r.Rows.Count - 1
   '读取r用于给i赋值,能够找到添加数据的起始位置
    ComboBox1.RowSource = "b2:b" & i
    '用于给复合框添加数据源,这一步是初始化中完成的
    '顺序不能搞错
    TextBox1 = Cells(2, 11)
    '这几个单元格存放的值是固定用的几个最大值
    '求最大值我是在工作表中间用的自带函数max
    '没有写在VBA代码中
    'VBA只需要进行传参就行了
    TextBox2 = Cells(2, 12)
    TextBox3 = Cells(2, 13)
    TextBox4 = Cells(2, 14)
    TextBox5 = Cells(2, 15)
End Sub

显示信息

Private Sub ComboBox1_Change()
Dim i As Long

 If ComboBox1.ListIndex > -1 Then
 '读取下拉框数据变化时
 '对应的读取数据跟着i变化
     i = ComboBox1.ListIndex + 2
     政治.Text = Cells(i, 3)
     数学.Text = Cells(i, 4)
     英语.Text = Cells(i, 5)
     专业课.Text = Cells(i, 6)
     总分.Text = Cells(i, 7)
     本科院校.Text = Cells(i, 8)
     
 End If
End Sub

添加信息

Private Sub 添加信息_Click()
Dim r As Range, i As Long
    
    Set r = Worksheets(2).UsedRange
    'worksheets(1)不能省略
    
    i = r.Row + r.Rows.Count
    If 姓名.Text <> "" Then
    Cells(i, 2) = 姓名.Text
    '将输入窗体里的数据传递给表格中
    '这里的姓名是添加字段后面的输入框,不是姓名后面的
    '所以输入也得在添加字段后面输入
    Cells(i, 3) = 政治.Text
    Cells(i, 4) = 数学.Text
    Cells(i, 5) = 英语.Text
    Cells(i, 6) = 专业课.Text
    Cells(i, 7) = CInt(政治.Text) + CInt(数学.Text) + CInt(英语.Text) + CInt(专业课.Text)
    '传的参数都是字符串,这里需要强制转换一下
    Cells(i, 8) = 本科院校.Text
    'i表示当前表格最后一行数据的下一行
    姓名.Text = ""
    '当添加完毕后,让窗体中的数据清零
    政治.Text = ""
    数学.Text = ""
    英语.Text = ""
    专业课.Text = ""
    总分.Text = ""
    本科院校.Text = ""
    End If
End Sub

修改信息

Private Sub 修改信息_Click()
Dim i As Long
Dim j As Long

   
 If ComboBox1.ListIndex > -1 Then
   i = ComboBox1.ListIndex + 2
   'i用来定位,保证对应在下拉框中选中的字段所在的位置
   j = MsgBox("修改第" & i & "行数据,是否确定?", vbYesNo)
   '点确定传的数字就是6
    If j = 6 Then
    Cells(i, 3) = 政治.Text
    Cells(i, 4) = 数学.Text
    Cells(i, 5) = 英语.Text
    Cells(i, 6) = 专业课.Text
    Cells(i, 7) = CInt(政治.Text) + CInt(数学.Text) + CInt(英语.Text) + CInt(专业课.Text)
    Cells(i, 8) = 本科院校.Text
    End If
    End If
End Sub

删除信息

Private Sub 删除信息_Click()
Dim i As Long

Dim j, r

    If ComboBox1.ListIndex > -1 Then
 
        i = ComboBox1.ListIndex + 2
        j = MsgBox("删除第" & i & "行数据,是否确定?", vbYesNo)
        '同上,确定对应的数字是6
            If j = 6 Then
                Rows(i).Delete
                '删掉整行,删除后,后面的数据补上,
                '而每次的i都是随用随读取
                '所以不用担心影响到其他地方的使用
            End If
    End If
End Sub

批量生成图表

在这里插入图片描述

单击任意数据源中的数据,弹出对应的折线图

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim mychart As ChartObject, ws As Worksheet, row As Long

Set ws = Worksheets("sheet2")

    row = Target.row
    
    If row < 13 And row > 2 Then
        If ws.ChartObjects.Count = 0 Then
        '如果现在没有图表,就新建一个
            Set mychart = ws.ChartObjects.Add(80, 240, 300, 200)
            '前2个代表左边距和上边距,后两个代表表的长和宽
        Else
            Set mychart = ws.ChartObjects(1)
            '如果有了,就把mychart指向该图表
        End If
        
        With mychart.Chart
        '定义mychart下面的chart属性
            
            .ChartType = xlLine
        '生成折线图
            .SetSourceData Source:=Range(ws.Cells(row, 3), ws.Cells(row, 12))
        '数据源
            .HasTitle = True
            '写标题
            .ChartTitle.Text = ws.Cells(row, 2)
            '没有上一句话这句话执行不了
        End With
    End If
        
End Sub

批量生成折线图

很遗憾,下面的几个代码在EXCEL2016中执行不了,我是在EXCEL2007中跑的
但是听课时老师的范例是在2016中运行的,问题我之后再想办法解决
在这里插入图片描述

单击数据源生成图表

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim mychart As ChartObject, ws As Worksheet, row As Double

Set ws = Worksheets("sheet1")

    row = Target.row
    
    If row < 13 And row > 2 Then
        If ws.ChartObjects.Count = 0 Then
        '如果现在没有图表,就新建一个
            Set mychart = ws.ChartObjects.Add(80, 240, 300, 200)
            '前2个代表左边距和上边距,后两个代表表的长和宽
        Else
            Set mychart = ws.ChartObjects(1)
            '如果有了,就把mychart指向该图表
        End If
        
        With mychart.Chart
        '定义mychart下面的chart属性
            
            .ChartType = xlLine
        '生成折线图
            .SetSourceData Source:=Range(ws.Cells(row, 4), ws.Cells(row, 15))
        '数据源
            .HasTitle = True
            '写标题
            .ChartTitle.Text = ws.Cells(row, 2)
            '没有上一句话这句话执行不了
        End With
    End If
        
End Sub

批量生成图表

在这里插入图片描述

Sub 批量生成折线图()
Dim mychart As ChartObject, ws As Worksheet
Dim i As Long, j As Long
Set ws = Worksheets("sheet1")

   If ws.ChartObjects.Count > 0 Then
   ws.ChartObjects.Delete
   End If
       
   For i = 3 To 12
  
    Set mychart = ws.ChartObjects.Add(((i - 3) Mod 3) * 350 + 50, (Int((i - 3) / 3) + 1) * 250, 300, 200)
            '前2个代表左边距和上边距,后两个代表表的长和宽
  
        With mychart.Chart
        '定义myChart下面的chart属性
            
            .ChartType = xlLine
        '生成折线图
            .SetSourceData Source:=Range(ws.Cells(i, 4), ws.Cells(i, 15))
        '数据源
            .HasTitle = True
            '写标题
            .ChartTitle.Text = ws.Cells(i, 3)
            '没有上一句话这句话执行不了
        End With
    Next i
        
End Sub

批量输出图表

在这里插入图片描述

Sub 输出折线图()

Dim mychart As ChartObject

For Each mychart In Worksheets("sheet1").ChartObjects
'扫描每一个图表

    If mychart.Chart.HasTitle Then
    
        mychart.Chart.Export "d:\" & mychart.Chart.ChartTitle.Text & ".jpg"
    '输出每个图表,用export语法,输出名字带标题,还要加上后缀名
    
    End If
    
Next mychart

End Sub
相关推荐
<p> <span style="font-size:24px;">      本课程属性Excel VBA中比较高阶的课程,主要讲解关于各种事件的应用,各种控件的应用,如果使用类模块,如果在VBA用调用SQL语句去处理数据库中的数据等操作。学习完成本课后,你可以在Excel中开发各种小型应用系统。以下是课程主要内容。</span> </p> <p> <span style="font-size:24px;background-color:#009900;color:#FFFFFF;"><strong>第1章:工作表,工作簿常用事件。</strong></span><br /><br /><span style="font-size:24px;background-color:#009900;color:#FFFFFF;"><strong>第2章:</strong></span><span style="font-size:24px;background-color:#009900;color:#FFFFFF;"><strong>窗体控件应用</strong></span><br /><br /><span style="font-size:24px;background-color:#009900;color:#FFFFFF;"><strong>第3章:</strong></span><span style="font-size:24px;background-color:#009900;color:#FFFFFF;"><strong>ActiveX控件应用</strong></span><br /><br /><span style="font-size:24px;background-color:#009900;color:#FFFFFF;"><strong>第4章:</strong></span><span style="font-size:24px;background-color:#009900;color:#FFFFFF;"><strong>类模块应用</strong></span><br /><br /><span style="font-size:24px;background-color:#009900;color:#FFFFFF;"><strong>第5章:</strong></span><span style="font-size:24px;background-color:#009900;color:#FFFFFF;"><strong>vba+ado+sql</strong></span><br /><br /><span style="font-size:24px;background-color:#009900;color:#FFFFFF;"><strong>第6章:</strong></span><span style="font-size:24px;background-color:#009900;color:#FFFFFF;"><strong>实战应用(考试系统开发)</strong></span><br /><span style="font-size:24px;"></span> </p>
©️2020 CSDN 皮肤主题: 大白 设计师:CSDN官方博客 返回首页