Excel 双斜线表头绘制

Excel 双斜线表头绘制

在模块中添加以下方法：

Sub 双斜线表头()
    Dim sht As Worksheet
    Dim rng As Range
    Dim line1 As Shape
    Dim line2 As Shape
    Dim txt1 As Shape
    Dim txt2 As Shape
    Dim txt3 As Shape
    Set sht = ActiveSheet
    Set rng = ActiveCell
    Set line1 = sht.Shapes.AddLine(rng.Left + rng.Width / 2, rng.Top, rng.Left + rng.Width, rng.Top + rng.Height)
    Set line2 = sht.Shapes.AddLine(rng.Left, rng.Top + rng.Height / 2, rng.Left + rng.Width, rng.Top + rng.Height)
    line1.ShapeStyle = msoLineStylePreset1
    line2.ShapeStyle = msoLineStylePreset1
    Set txt1 = sht.Shapes.AddTextbox(msoTextOrientationHorizontal, rng.Left, rng.Top, rng.Width / 2, rng.Height / 2)
    Set txt2 = sht.Shapes.AddTextbox(msoTextOrientationHorizontal, rng.Left + rng.Width / 9 * 5, rng.Top, rng.Width / 9 * 4, rng.Height / 2)
    Set txt3 = sht.Shapes.AddTextbox(msoTextOrientationHorizontal, rng.Left, rng.Top + rng.Height / 3 * 2, rng.Width / 2, rng.Height / 3)
    txt1.Fill.Visible = msoFalse
    txt2.Fill.Visible = msoFalse
    txt3.Fill.Visible = msoFalse
    txt1.Line.Visible = msoFalse
    txt2.Line.Visible = msoFalse
    txt3.Line.Visible = msoFalse
    txt1.TextFrame2.TextRange.Text = "销量"
    txt2.TextFrame2.TextRange.Text = "产品"
    txt3.TextFrame2.TextRange.Text = "月份"
    sht.Shapes.Range(Array(line1.Name, line2.Name, txt1.Name, txt2.Name, txt3.Name)).Group
End Sub

选中单元格，运行代码，效果如图：