VBA_动态新建sheet及控件

Option Explicit

'Analyse
Sub CreateSheets()
    Dim ArrPersons() As String
    Dim IPerCount As Integer
    Dim i As Integer, WsThis As Worksheet
    Dim StrSheetName As String
    Dim IsChgSet As Boolean
    Dim Wstemp  As Worksheet
    Dim WsList As Worksheet
    Application.ScreenUpdating = False
    'On Error Resume Next
    'Debug.Print ThisWorkbook.VBProject.Protection
    Dim ObjComboBoxYear As OLEObject
    Dim ObjComboBoxMOnth As OLEObject
    Set WsList = Workbooks("CD.xls").Worksheets("HolidaySheet")
    IPerCount = GetPersonsFromOutSheet(ArrPersons)
    'MsgBox GArrStrOpenFileHead(1, 1) & 1
    If IPerCount > 0 Then
        For i = 0 To IPerCount - 1
            StrSheetName = "担当者" & ArrPersons(i) & "予定分析"
            If ChkHaveSheet(StrSheetName) Then
                'Application.DisplayAlerts = False
                Worksheets(StrSheetName).Delete
                'Application.DisplayAlerts = True
            End If

            Worksheets("planasheet").Copy after:=Worksheets(3)

            Set Wstemp = Worksheets(4)
            With Wstemp
                .Name = StrSheetName
                Set ObjComboBoxYear = .OLEObjects("CmbYear")
                Set ObjComboBoxMOnth = .OLEObjects("CmbMonth")
                With WsList
                    ObjComboBoxYear.Object.List = .Range("C2:C" & .Range("C1").End(xlDown).Row).Value
                    ObjComboBoxMOnth.Object.List = .Range("D2:D" & .Range("D1").End(xlDown).Row).Value
                End With
            End With
            Set WsThis = Worksheets(StrSheetName)
            If Not WriterConTents(WsThis, ArrPersons(i)) Then
                MsgBox "error"
                Exit Sub
            End If
        Next i
    End If
End Sub
Function WriterConTents(WsThis As Worksheet, ArrPersons As String) As Boolean
    Dim RngTemp As Range
    Dim i As Long, j As Long

    WriterConTents = False
    With WsThis
        .Cells(2, 2).Interior.color = 255
        .Cells(2, 3).Value = "  1日当りの作業時間が7Hを越える場合と遅れが生ずる場合には警告を表示する"
    End With
    With WsThis
           Workbooks("CD.xls").Worksheets("担当者A予定分析1").Range("B5:O11").Copy .Range("B5")
    End With
    Dim IstartLine As Long
    IstartLine = GetStartLine(WsThis)
    With WsThis
        'Call AddComboBoxYear(WsThis, .Cells(IstartLine, 2))
        Cells(IstartLine, 3) = "年"
        'Call AddComboBoxMonth(WsThis, .Cells(IstartLine, 4))
        Cells(IstartLine, 5) = "月"
        'Call AddButton(WsThis, .Cells(IstartLine, 6))
    End With
    WriterConTents = True
End Function

Function GetStartLine(WsThis As Worksheet) As Long
    With WsThis
        GetStartLine = Cells(.Rows.Count, 2).End(xlUp).Row + 2
    End With
End Function
Sub AddClickCode(WsThis As Worksheet, StrName As String)
    Dim StrCodes As String
    Dim OBjVba As Object
    Dim ObjShtModule As Object

    StrCodes = vbCrLf & "Private Sub " & StrName & "_Click()" & vbCrLf & "call " & "showAAA" & vbCrLf & "End Sub"
    Set OBjVba = ActiveWorkbook.VBProject
    Set ObjShtModule = OBjVba.VBComponents(WsThis.CodeName).CodeModule
    With ObjShtModule
        .InsertLines .countoflines + 1, StrCodes
    End With
End Sub
Sub AddComboBoxYear(WsThis As Worksheet, ByVal RngTarget As Range)
    Dim ObjComboBox As OLEObject
    Dim WsList As Worksheet
    'Set RngTarget = WsThis.Cells(1, 1)
    Set ObjComboBox = WsThis.OLEObjects.Add(ClassType:="Forms.combobox.1", Link:=False, DisplayAsIcon:=False, Left:=RngTarget.Left, Top:=RngTarget.Top, Width:=RngTarget.Width, Height:=RngTarget.Height + 4)
    Set WsList = Workbooks("CD.xls").Worksheets("HolidaySheet")
    ObjComboBox.Visible = True
    ObjComboBox.Name = "CmbYear"
    With WsList
        ObjComboBox.Object.List = .Range("C2:C" & .Range("C1").End(xlDown).Row).Value
    End With
    Randomize
    ObjComboBox.Object.ListIndex = Int(Rnd * 7)
End Sub
Sub AddComboBoxMonth(WsThis As Worksheet, ByVal RngTarget As Range)
    Dim ObjComboBox As OLEObject
    Dim WsList As Worksheet
    'Set RngTarget = WsThis.Cells(1, 3)
    Set ObjComboBox = WsThis.OLEObjects.Add(ClassType:="Forms.combobox.1", Link:=False, DisplayAsIcon:=False, Left:=RngTarget.Left - 10, Top:=RngTarget.Top, Width:=RngTarget.Width, Height:=RngTarget.Height + 4)
    Set WsList = Workbooks("CD.xls").Worksheets("HolidaySheet")
    ObjComboBox.Visible = True
    ObjComboBox.Name = "CmbMonth"
    With WsList
        ObjComboBox.Object.List = .Range("D2:D" & .Range("D1").End(xlDown).Row).Value
    End With
    Randomize
    ObjComboBox.Object.ListIndex = Int(Rnd * 7)
End Sub
Sub AddButton(WsThis As Worksheet, ByVal RngTarget As Range)
    Dim ObjCommandButton As OLEObject
    'Set RngTarget = WsThis.Cells(1, 5)
    Set ObjCommandButton = WsThis.OLEObjects.Add(ClassType:="Forms.commandbutton.1", Link:=False, DisplayAsIcon:=False, Left:=RngTarget.Left - 10, Top:=RngTarget.Top - 3, Width:=RngTarget.Width + 4, Height:=RngTarget.Height + 10)
    ObjCommandButton.Visible = True
    ObjCommandButton.Name = "CmdSetDate"
    ObjCommandButton.Object.Caption = "設定"
End Sub
Sub showAAA()
    MsgBox ActiveSheet.Cells(6, 6)
End Sub