160.一键创建斜线表头

'###############################################################

'函数作用：一键创建斜线表头

'###############################################################

Sub 斜分单元格(sht As Worksheet, row As Integer, col As Integer)

    sht.Cells(row, col).Select

    '设置左上至右下的斜线

    With Selection.Borders(xlDiagonalDown)

        .LineStyle = xlContinuous

        .Weight = xlThin

        .ColorIndex = xlAutomatic

    End With

    '声明字符串变量

    Dim aim As String

    Dim Mid As Integer

    '获取所选区域的字符串

    aim = Selection.Value

    '去除字符串中的空格

    aim = Replace(aim, " ", "")

    '查找\符号，并记录其位置

    Mid = InStr(1, aim, "\")

    '将\替换为空格

    aim = Replace(aim, "\", " ")

    '将经过修改的内容写回单元格中

    Selection.Value = aim

    '判断字符串是否符合约定

    If Mid = 0 Then

        Exit Sub

    End If

    '设置左下字符串格式

    With Selection.Characters(Start

        = 1, _

          Length

        = Mid ‐ 1).Font

        .Name = "宋体"

        .Size = 16

        .Strikethrough = False

        .Superscript = False

        .Subscript = True '设为下标

        .OutlineFont = False

        .Shadow = False

        .Underline = xlUnderlineStyleNone

        .ColorIndex = xlAutomatic

    End With

    '设置右上字符串的格式

    With Selection.Characters(Start

        = Mid + 1, _

          Length

        = Len(aim) ‐ Mid).Font

        .Name = "宋体"

        .Size = 16

        .Strikethrough = False

        .Superscript = True '设为上标

        .Subscript = False

        .OutlineFont = False

        .Shadow = False

        .Underline = xlUnderlineStyleNone

        .ColorIndex = xlAutomatic

    End With

    '自动调整选择区域的行高和列宽

    With Selection

        .Rows.AutoFit

        .Columns.AutoFit

    End With

End Sub