通过VBA制作Excel田字格

制作Excel田字格的话,可以通过单元格格式+线条的方式快速制作,博主在玩儿VBA,也顺带编(摘)写(抄)了一个小工具,可以方便一键生成田字格。后面如果有更多有用的小功能的话再做一个插件来玩儿。

使用方式就是,添加一个按钮控件,绑定这个函数,之后选中需要变成田字格的单元格,然后点击按钮调用该函数即可,先看下效果:

简单记录下代码:

''' 田字格
Sub tt()
    ''' 设置长宽相等
    Dim x&, Y&, a As Range, xx As Range, Left1&, Top&, Width&, Height&, N&
    N = 30  ' 为单元格大小
    Set a = Selection(1)
    a.RowHeight = N
    a.ColumnWidth = N
    With ActiveWindow
        x = .PointsToScreenPixelsX(a.Width) - .PointsToScreenPixelsX(0)
        Y = .PointsToScreenPixelsY(a.Height) - .PointsToScreenPixelsY(0)
    End With
    ''' 设置各单元长宽相等
    For Each xx In Selection.Rows
        xx.RowHeight = N
    Next
    For Each xx In Selection.Columns
        xx.ColumnWidth = N * Y / x
    Next
    ''' 设置文字居中
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    ''' 各单元格画线
    With Selection(1)
        Width1 = .Width
        Height1 = .Height
    End With
    For Each xx In Selection
        With xx
            Left1 = .Left
            Top1 = .Top
        End With
        ''' 加粗边框
        With xx.Borders
            .LineStyle = xlContinuous
            .Weight = xlMedium
        End With
        ''' 横线
        ActiveSheet.Shapes.AddConnector(msoConnectorStraight, Left1, Top1 + Height1 * 0.5, Left1 + Width1, Top1 + Height1 * 0.5).Select
        ''' 竖线
        ActiveSheet.Shapes.AddConnector(msoConnectorStraight, Left1 + Width1 * 0.5, Top1, Left1 + Width1 * 0.5, Top1 + Height1).Select
    Next
End Sub

 

 

发表评论