使用消息框更改范围的字体颜色?和工作表选择?

时间:2019-03-15 20:42:17

标签: excel vba fonts msgbox

我写了一个宏,它可以做一些事情。它询问您的名字和姓氏,将其放在单元格中,给几个单元格上色,列出今天的日期以及从现在开始一个月,从现在开始两个月,...以及从现在开始十二个月的日期。我将不再在那里解释它,因为这就是我的问题所在。

我需要使用y / n消息框来询问用户是否要将前6个日期涂成红色,并询问他们是否要使后6个日期涂成蓝色。如果他们为第一个选择“是”,我将突出显示这6个日期并更改字体。蓝色同样。很简单。

我要弹出消息框,但是当我选择“是”时-字体不变。代码只是继续前进。问题从我有“ ColorAsk = MsgBox ...”的行开始

Sub FirstTrial()
'
' FirstTrial Macro
'
' Keyboard Shortcut: Ctrl+Shift+W
'
    Dim FirstName As String
    Dim LastName As String
    Dim Range1 As Range, Data1 As Range
    Dim ColorsAsk As VbMsgBoxResult
    Dim ColorsAsk2 As VbMsgBoxResult
    FirstName = InputBox("Please enter your first name")
    LastName = InputBox("Please enter your last name")
    Range("A1").Select
    ActiveCell.Value = "First Name:"
    Range("A2").Select
    ActiveCell.Value = "Last Name:"
    'Range("B6").Select
    Columns("A:A").EntireColumn.AutoFit
    Range("B1").Select
    ActiveCell.Value = FirstName
    Range("B2").Select
    ActiveCell.Value = LastName
    Range("A1:A2").Select
    Selection.Font.Bold = True
    Range("B1:B2").Select
    With Selection.Interior 'Puts With in front of each of the following lines
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("A3").Select
    ActiveCell.Value = "=TODAY()"
    Set Range1 = Range("A4:A15")
    For Each Data1 In Range1
        Data1 = "=EDATE(R[-1]C,1)"
        Data1.Select
        With Selection
            .NumberFormat = "m/d/yy"
        End With
        Next Data1
    ColorsAsk = MsgBox("Would you like the first 6 months colored red?", vbYesNo + vbDefaultButton1, "Coloring")
        If ColorAsk = 6 Then
        Range("A4:A9").Font.Color = vbRed
        End If
    ColorsAsk2 = MsgBox("Would you like the latter 6 months colored blue?", vbYesNo + vbDefaultButton1, "Coloring")
        If ColorAsk2 = 6 Then
        Range("A10:A15").Font.Color = vbBlue
        End If
    Worksheets.Add Before:=Worksheets(1)
    ActiveSheet.Name = FirstName
    Sheets(FirstName).Range("A1:A13").Value = Sheets("Sheet1").Range("A3:A15").Value

End Sub

还有第二个问题-并不是完全必要的,但可以帮助您知道...。此代码的倒数第二个工作是创建一个工作表,该工作表的名称为您输入的名字。该代码要做的最后一件事是从初始工作表中复制日历,并将其粘贴到新创建的工作表中。现在,我假设初始工作表的标题为“ Sheet1”。不管初始工作表的名称是什么,有没有办法做到?

0 个答案:

没有答案