VBA常用代码 – 03

  • Post author:
  • Post category:其他


1、输入日期,返回周几和该月剩余工作天数

Sub test()

    Dim dt As Date, t1 As Integer, t2 As Date, i As Date, temp As Integer

    dt = Application.InputBox("请输入日期:" & Chr(10) & _
    "如:2021-09-08", _
    "选择日期", "2021-09-08", , , , 1)


    t1 = Weekday(dt, 2)
    t2 = DateSerial(Year(dt), Month(dt) + 1, 1) - 1
    
    
    For i = dt + 1 To t2
        If Weekday(i, 2) < 6 Then temp = temp + 1
    Next

    MsgBox "该输入日期为周" & t1 & Chr(10) & "该月剩余工作天数为" & temp

End Sub

2、获取指定路径的名称

Sub 获取指定路径名称()

    Dim PathSht As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "请选择一个文件夹"
        If .Show = -1 Then PathSht = .SelectedItems(1) Else Exit Sub  ' 若文件选择框选择“cancel”则返回-1,此时退出程序
    End With
    PathSht = PathSht & IIf(Right(PathSht, 1) = "\", "", "\")  ' 保证路径以"\"结尾
    MsgBox PathSht
    '后续可以接处理该文件夹下面的操作

End Sub

3、获取所选文件的名称

Sub 获取所选文件的名称()
  Dim Item As Integer
  With Application.FileDialog(msoFileDialogFilePicker)

    If .Show = -1 Then
      For Item = 1 To .SelectedItems.Count
        MsgBox .SelectedItems(Item)
      Next Item
    Else
      Exit Sub
    End If

  End With
End Sub

4、浏览指定类型文件

Sub 浏览指定类型文件()
    On Error Resume Next
    Dim FileName, i As Integer
    
    FileName = Application.GetOpenFilename("文本文件,*.xlsx", , "请选择文本文件", , True) ' 注意"文本文件,*.xlsx"是右下角的提示,删除“,”后会报错
    
    If Err.Number > 0 Then Exit Sub
    
    For i = 1 To UBound(FileName)
        MsgBox FileName(i)  '注意:会返回路径+文件名的形式
    Next i
End Sub

5、在左下角一直显示:“培训”

Sub auto_open()
    
    Application.StatusBar = "培训"
End Sub

6、关闭前将“A1”单元格赋值“ok”

Sub auto_close()
    
    Range("A1") = "ok"
    ThisWorkbook.Save
    
End Sub



版权声明:本文为weixin_46623003原创文章,遵循 CC 4.0 BY-SA 版权协议,转载请附上原文出处链接和本声明。