Question

我想知道是否可以填充在屏幕上绘制的Rectangle对象的某个百分比，这样它就像一个进度条，在那里你可以看到它的＆＃34;级＆＃34;上下。具体来说，我想从上到下而不是从左到右填充它。

Answer 1

你可以试试这个。

Sub SaveWorkbookAsNewFile()
Dim ActSheet As Worksheet
Dim ActBook As Workbook
Dim CurrentFile As String
Dim NewFileType As String
Dim NewFile As String
Dim NewFileName As String

NewFileName = "Checklist " & Format(Now, "MMMM-dd-yyyy")


Application.ScreenUpdating = False    ' Prevents screen refreshing.

CurrentFile = ThisWorkbook.FullName

NewFileType = "Excel Files 1997-2003 (*.xls), *.xls," & _
           "Excel Files 2007 (*.xlsx), *.xlsx," & _
           "All files (*.*), *.*"

NewFile = Application.GetSaveAsFilename( _
    InitialFileName:=NewFileName, _
    fileFilter:=NewFileType)

If NewFile <> "" And NewFile <> "False" Then
    ActiveWorkbook.SaveAs filename:=NewFile, _
        FileFormat:=xlNormal, _
        Password:="", _
        WriteResPassword:="", _
        ReadOnlyRecommended:=False, _
        CreateBackup:=False

    Set ActBook = ActiveWorkbook
    Workbooks.Open CurrentFile
    ActBook.Close
End If

Application.ScreenUpdating = True

部分填充Rectangle对象

1 个答案: