玖叶教程网

Excel每次新建工作表要从一个空表格开始，然后分别设置表格参数，然后输入数据。

感觉有点麻烦，如果是初学者，可能根本找不到在哪里设置单元格格式。

本节介绍一种方法，制作一个全功能建表格式，选择相应的格式，然后一键完成。

上图为可选择的功能项，可以看到，有表的行数、列数、颜色、字体、字号等等格式。

另外标题和边框可以选择或者不选。

选择完成后单击新建按钮就可以看到下图完成的新表了。

是不是很简单。

当然，数据还是要自己录入，不过后续有时间，也可以完成数据录入的功能。

下图为换了一种格式的新建表。

如果是这样简单的二维表创建，那么使用这样的方法，在很短的时间内可以完成很多个表新建，实际上完全可以增加一行代码一次新建多个相同的表。

本示例就不展示出来了。

重点看一下代码实现方法

图中的控件使用了解代码创建，如下代码所示：

Private Sub setListLabelAndText()'添加Label和ComboBoxr控件
    i = 0
    For Each x In xArr
        Set xobj = Me.Controls.Add("Forms.Label.1")
            With xobj
                .Height = 28
                .Top = i * .Height + Me.Label1.Top + Me.Label1.Height + 10
                .Left = 120
                .Width = 60
                .Caption = x
            End With
        Set tobj = Me.Controls.Add("Forms.ComboBox.1", x)
            With tobj
                .Height = xobj.Height - 4
                .Top = xobj.Top - 2
                .Left = xobj.Left + xobj.Width + 10
                .Width = 280
                .BorderStyle = 1
                .BorderColor = RGB(211, 211, 211)
                If i = 6 Then
                    .List = fArr '字体
                Else
                    .List = lArr
                End If
                .Value = 1
                .Style = 2
            End With
            If VBA.InStr(1, x, "颜色") <> 0 Then
                ComChangeC(i).inic tobj
            End If
            i = i + 1
    Next x
    For Each t In tArr
        Set xobj = Me.Controls.Add("Forms.Label.1")
            With xobj
                .Height = 28
                .Top = i * .Height + Me.Label1.Top + Me.Label1.Height + 10
                .Left = 120
                .Width = 60
                .Caption = t
            End With
        Set tobj = Me.Controls.Add("Forms.TextBox.1", t)
            With tobj
                .Height = xobj.Height - 4
                .Top = xobj.Top - 2
                .Left = xobj.Left + xobj.Width + 10
                .Width = 230
                .BorderStyle = 1
                .BorderColor = RGB(211, 211, 211)
                .Value = "新建工作表标题名称"
            End With
            i = i + 1
    Next t
    i = 1
    For Each o In oArr
        Set oobj = Me.Controls.Add("Forms.CheckBox.1", o)
            With oobj
                .Height = tobj.Height
                .Top = tobj.Top + (tobj.Height + 2) * i
                .Left = tobj.Left
                .Width = 80
                .Caption = o
                .Value = True
            End With
            Clk(i).inic oobj
            i = i + 1
    Next o
    Set xobj = Nothing
    Set tobj = Nothing
    Set oobj = Nothing
End Sub

本例中还新建了两个类模块，一个是ComboBox的Change事件，另一个是CheckBox的Click事件。

由于是动态新建的控件，事件也要动态引入。

ComboBox类模块代码：

Option Explicit
Public WithEvents cli As MSForms.ComboBox
Public Sub inic(bt As MSForms.ComboBox)
    Set cli = bt
End Sub
Private Sub cli_Change()
ActiveSheet.Range("A1").Interior.ColorIndex = cli.Value
Dim cx
cx = ActiveSheet.Range("A1").Interior.Color
cli.BackColor = cx
End Sub

CheckBox类模块代码：

Option Explicit
Public WithEvents cli As MSForms.CheckBox
Public Sub inic(bt As MSForms.CheckBox)
    Set cli = bt
End Sub
Private Sub cli_Click()
Select Case cli.Caption
        Case oArr(0) '表头
            If cli.Value Then
                SetCombTrueOrFalse tArr(0), True
            Else
                SetCombTrueOrFalse tArr(0), False
            End If
        Case oArr(1) '标题
            If cli.Value Then
                SetCombTrueOrFalse xArr(4), True
            Else
                SetCombTrueOrFalse xArr(4), False
            End If
End Select
End Sub
Private Sub SetCombTrueOrFalse(xStr As Variant, xBoolean As Boolean)
    For Each xobj In cli.Parent.Controls
        If xobj.Name = xStr Then
            xobj.Value = ""
            xobj.Enabled = xBoolean
        Exit For
        End If
    Next xobj
End Sub

Form窗体代码还是比较多，也就是一些控件属性设置，不贴出来了。

最重要的一段代码为按钮代码：

Private Sub CommandButton1_Click()
'新建工作表
For Each xobj In Me.Controls
    If TypeName(xobj) = "ComboBox" Then
        If VBA.Len(xobj) = 0 Then MsgBox "信息不能为空值！", vbInformation, "提示": Exit Sub
        For i = 0 To UBound(xArr)
            If xArr(i) = xobj.Name Then
                If VBA.Len(xobj) <> 0 And i <> 6 Then
                    yArr(i) = VBA.CInt(xobj.Value)
                ElseIf VBA.Len(xobj) <> 0 And i = 6 Then
                    yArr(i) = VBA.CStr(xobj.Value)
                Else
                    yArr(i) = 0
                End If
            End If
        Next i
    End If
    If TypeName(xobj) = "TextBox" Then
        For i = i To UBound(tArr) + i
            If tArr(i - i) = xobj.Name Then
                ReDim Preserve yArr(i)
                yArr(i) = xobj.Value
            End If
        Next i
    End If
Next xobj
MsgBox Join(yArr)
Dim s As Worksheet, r As Range
Set s = ThisWorkbook.Worksheets.Add(before:=Sheets(1))
s.UsedRange.Clear
Set r = s.Range(s.Cells(1, 1), s.Cells(yArr(1), VBA.CInt(yArr(0))))
With r
    .Interior.ColorIndex = yArr(2)
    .Font.ColorIndex = yArr(3)
    .RowHeight = yArr(5)
    .Font.Name = yArr(6)
    .Font.Size = yArr(7)
End With
If VBA.Len(yArr(4)) <> 0 Then '如果有边框
    r.Borders.LineStyle = 1
    r.Borders.ColorIndex = yArr(4)
Else
    r.Borders.LineStyle = 0
End If
If VBA.Len(yArr(8)) <> 0 Then '如果有标题
    s.Rows(1).Insert shift:=xlUp
    s.Range("A1").Resize(1, yArr(0)).Merge
    With s.Range("A1")
        .VerticalAlignment = xlCenter
        .HorizontalAlignment = xlCenter
        .Value = yArr(8)
    End With
End If
End Sub

严格来说，每一段代码都十分重要，没有哪一段也不能完全实现过程，重点并不是代码如何进行排列，问题是要对整个流程进行一个清晰的认识。

当对整个流程完全了解之后，用这些字母来创建一个过程，那么就把一个实用的功能变成了事实，编程就是一个创建世界的过程，只不过把每一个时间片段分开来研究，编码之后变成真实的再现罢了。

欢迎关注、收藏

---END---