自定义快捷键【个人常用】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
评论 1
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包

打赏作者

小基基o_O

您的鼓励是我创作的巨大动力

¥1 ¥2 ¥4 ¥6 ¥10 ¥20
扫码支付:¥1
获取中
扫码支付

您的余额不足,请更换扫码支付或充值

打赏作者

实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值