VBA 用户窗体的应用

用户窗体，今日继续~每次都是一样的标题，这次换了下

 

 

 

 

 

一、使用外部控件做个简单的音乐/视频播放器

对着工具栏点一下右键，就会出现附加组件，找到需要用的外部组件就可以啦，比如咱们要做个视频播放，只需要在附加组件中添加 WindowsMediaPlayer即可，结合昨天我们的列表框，做个简单的音乐或者视频播放器：

具体代码如下（CommandButton1 是播放按钮，CommandButton2是打开文件夹按钮）：

Private Sub CommandButton1_Click()
    On Error Resume Next
    Me.WindowsMediaPlayer1.Url = Me.ListBox1.Value
End Sub

Private Sub CommandButton2_Click()
    Dim path As String
    Dim file As String
    Dim i As Integer
    
    On Error Resume Next
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = "D:\"
        .Title = "选择一个文件夹"
        .Show
        path = .SelectedItems(1)
    End With
    
    file = Dir(path & "\*.mp4")
    For i = 1 To 100
        If file = "" Then
            Exit For
        End If
        Me.ListBox1.AddItem path & "\" & file
        file = Dir
    Next
    
End Sub

把第20行的MP4改成MP3就可以播放音频文件了。

 

二、非模态化窗口

非模态化窗口之前提到过，需要新建一个模块，新建一个模块，写一句UserForm.show 0 就可以啦，然后要实现以下“哪里不清楚点哪里”功能也是很简单：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    UserForm1.Caption = "选中单元格：" & Target.Address
    UserForm1.Label1.Caption = "公    式:    " & Target.Formula
    UserForm1.Label2.Caption = "数字格式:    " & Target.NumberFormat
    UserForm1.Label3.Caption = "是否锁定:    " & Target.Locked
End Sub

三、显示进度条

① 利用Excel左下角的StatusBar来显示进度条，格子框框表示进度

下面是具体的代码啦：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim fin As Integer
    Dim perct As String
    Dim total As Integer
    Dim a As String, b As String
    Dim i As Integer
    
    a = "■"
    b = "□"
    total = Range("A1048576").End(xlUp).row - 1
    fin = Application.WorksheetFunction.CountIf(Range("B2:B1048576"), "已完成")
    
    If Round(fin / total, 1) * 10 > 1 Then
        For i = 1 To Round(fin / total, 1) * 10
            perct = perct & a
        Next
    End If
    
    If Round(fin / total, 1) * 10 < 10 Then
        For i = 1 To 10 - Round(fin / total, 1) * 10
            perct = perct & b
        Next
    End If
    
    Application.StatusBar = "已完成：" & perct & Round(fin / total, 2) * 100 & "%"
End Sub

当然了，这个进度条很丑。。。

 

②利用用户窗体做独立进度条

先做个这样的界面，插入个Frame和Label，把标签页的背景设置成红色，用标签页的长度来代表进度条，进度条如果为100%就不显示

具体代码如下：

Sub percent()
    Dim fin As Integer
    Dim perct As String
    Dim total As Integer

    total = Range("A1048576").End(xlUp).row - 1
    fin = Application.WorksheetFunction.CountIf(Range("B2:B1048576"), "已完成")
    
    If fin / total < 1 Then
        UserForm8.Show 0
        UserForm8.Frame1.Caption = "已完成：" & CStr(Round(fin / total, 2) * 100) & "%"
        UserForm8.Label1.Width = Round(180 * fin / total, 0)
    Else
        UserForm8.Hide
    End If
End Sub

设置完了记得在sheet1上的change事件中进行调用：

Private Sub Worksheet_Change(ByVal Target As Range)
    Call percent
End Sub

 

明天继续~