vba新建指定名稱工作表-tft每日頭條

Excel每次新建工作表要從一個空表格開始，然後分别設置表格參數，然後輸入數據。

感覺有點麻煩，如果是初學者，可能根本找不到在哪裡設置單元格格式。

本節介紹一種方法，制作一個全功能建表格式，選擇相應的格式，然後一鍵完成。

vba新建指定名稱工作表（VBA自動創建工作表）1

上圖為可選擇的功能項，可以看到，有表的行數、列數、顔色、字體、字号等等格式。

另外标題和邊框可以選擇或者不選。

選擇完成後單擊新建按鈕就可以看到下圖完成的新表了。

是不是很簡單。

當然，數據還是要自己錄入，不過後續有時間，也可以完成數據錄入的功能。

vba新建指定名稱工作表（VBA自動創建工作表）2

下圖為換了一種格式的新建表。

如果是這樣簡單的二維表創建，那麼使用這樣的方法，在很短的時間内可以完成很多個表新建，實際上完全可以增加一行代碼一次新建多個相同的表。

本示例就不展示出來了。

vba新建指定名稱工作表（VBA自動創建工作表）3

重點看一下代碼實現方法

圖中的控件使用了解代碼創建，如下代碼所示：

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

vba新建指定名稱工作表（VBA自動創建工作表）4

本例中還新建了兩個類模塊，一個是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---