全民一起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
发布了21 篇原创文章 · 获赞 5 · 访问量 1016
展开阅读全文

没有更多推荐了,返回首页

©️2019 CSDN 皮肤主题: 大白 设计师: CSDN官方博客

分享到微信朋友圈

×

扫一扫,手机浏览