自定义快捷键【个人常用】VBA代码

Office2013版

蓝色填充

Sub FillBule()
' 快捷键: Ctrl+Shift+B
    With Selection.Interior 'interior:内部
        .ThemeColor = xlThemeColorAccent1 'accent:强调
        .TintAndShade = 0.8 'tint:色彩
    End With
End Sub

合并居中换行

Sub MergeCells()
' 快捷键: Ctrl+Shift+C
    Application.DisplayAlerts = False
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True 'wrap:缠绕
        .MergeCells = True 'merge:合并
    End With
    Application.DisplayAlerts = True
End Sub

保存当前sheet

修改bookname

Sub SaveSheet()
' 快捷键: Ctrl+Shift+S
'声明
    Dim newbook As Workbook, nowsheet As Worksheet, sheetname$, bookname$, ymd$
'赋值
    ymd = [Text(today(), "yyyymmdd")]
    sheetname = ActiveSheet.Name
    bookname = "C:\Users\yellow\Desktop\" & sheetname & ymd & ".xlsx"
    Set nowsheet = ActiveSheet
    Set newbook = Workbooks.Add
'警告关闭
    Application.DisplayAlerts = False
'复制
    nowsheet.Copy newbook.Sheets(1)
    newbook.SaveAs bookname
    newbook.Close
'警告恢复
    Application.DisplayAlerts = True
End Sub

全域字体格式

Sub 全域字体()
' 快捷键: Ctrl+Shift+Q
    Cells.Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
    End With
    With Selection.Font
        .Name = "宋体"
        .Size = 9
    End With
End Sub

色阶(绿)

Sub GreenGradation()
' 快捷键: Ctrl+Shift+G
    Selection.FormatConditions.AddColorScale ColorScaleType:=2
'低位色
    Selection.FormatConditions(1).ColorScaleCriteria(1).Type = xlConditionValueLowestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
        .Color = 16776444
    End With
'高位色
    Selection.FormatConditions(1).ColorScaleCriteria(2).Type = xlConditionValueHighestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor
        .Color = 8109667
    End With
End Sub

热力图(红-蓝)

Sub Hot()
' 快捷键: Ctrl+Shift+H
    Selection.FormatConditions.AddColorScale ColorScaleType:=3
'低位色
    Selection.FormatConditions(1).ColorScaleCriteria(1).Type = xlConditionValueLowestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
        .Color = 13011546
    End With
'中位色
    Selection.FormatConditions(1).ColorScaleCriteria(2).Type = xlConditionValuePercentile
    Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50
    With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor
        .Color = 16776444
    End With
'高位色
    Selection.FormatConditions(1).ColorScaleCriteria(3).Type = xlConditionValueHighestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor
        .Color = 7039480
    End With
End Sub

Office2019版

热力图(红-蓝)

Sub Hot()
' 快捷键: Ctrl+Shift+H
    Selection.FormatConditions.AddColorScale ColorScaleType:=3
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).ColorScaleCriteria(1).Type = xlConditionValueLowestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
        .Color = 13011546
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).ColorScaleCriteria(2).Type = xlConditionValuePercentile
    Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50
    With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor
        .Color = 16776444
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).ColorScaleCriteria(3).Type = xlConditionValueHighestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor
        .Color = 7039480
        .TintAndShade = 0
    End With
End Sub