« スケジュール表作成(1) | Main | プリンタアイコンを消せなくする »

Jan 05, 2007

スケジュール表作成(2)

下記のようなVBAを作成しました。
Workdayの計算より日付を持ってきています。
このソースがそのまま使えるものではありません。自分のメモです。

-------------------------------------------------------------

Private Sub Workbook_Open()

    Sheets("START0").Activate

End Sub

-------------------------------------------------------------

Private Sub CommandButton1_Click()

    Dim Sheet_name As String
    Dim New_sheet_name As String
    Dim Month_MMM As String
    Dim Year_yyyy As String
    Dim Year_yy As String
    Dim TODAY_c As Date
    Dim TODAY_mm As Integer
    Dim START0, CALC As Object
    Dim Workday(40) As String
    Dim i, j, k As Integer

    '***************************
    ' Worksheetの定義

    Set START0 = ThisWorkbook.Worksheets("START0")
    Set CALC = ThisWorkbook.Worksheets("CALC")

    ' シート名を取得 yyyy-mm
    Sheets("START0").Activate
    Sheet_name = "H" & Range("I8") & Range("J8") & "-" & Range("M8") & Range("N8")

    '***************************
    ' 年月を取得

    Month_MMM = Format(Range("G6"), "mmm")
    Month_mm = Format(Range("G6"), "mm")
    Year_yyyy = Format(Range("G6"), "yyyy")
    Year_yy = Format(Range("G6"), "yy")

   

    '**************************
    ' 2/2のシート作成
    '**************************
    ' 2/2のシートをコピー

    Sheets("ORG").Select
    Sheets("ORG").Copy After:=Sheets(3)
    Sheets("ORG (2)").Name = Sheet_name & "-(2)"

    ' 追加したシートの名前を取得
    New_sheet_name = Worksheets(4).Name

    ' 変更箇所
    With Worksheets(New_sheet_name)
        .Range("S5") = START0.Range("I8")
        .Range("T5") = START0.Range("J8")
        .Range("V5") = START0.Range("M8")
        .Range("W5") = START0.Range("N8")
        .Range("C11") = START0.Range("G10")
        .Range("C13") = START0.Range("G12")
        .Range("Z5") = "2/2"
    End With

   
   

    '**************************
    ' 1/2のシート作成
    '**************************
    ' 1/2のシートをコピー

    Sheets("ORG").Select
    Sheets("ORG").Copy After:=Sheets(3)
    Sheets("ORG (2)").Name = Sheet_name & "-(1)"

    ' 追加したシートの名前を取得
    New_sheet_name = Worksheets(4).Name

    ' 変更箇所
    With Worksheets(New_sheet_name)
        .Range("S5") = START0.Range("I8")
        .Range("T5") = START0.Range("J8")
        .Range("V5") = START0.Range("M8")
        .Range("W5") = START0.Range("N8")
        .Range("C11") = START0.Range("G10")
        .Range("C13") = START0.Range("G12")
        .Range("B21") = "hoge-BANK-" & Month_MMM & Year_yy
        .Range("B22") = "BANK-" & Month_MMM & "-" & Year_yyyy
    End With

   

    '**************************
    ' Working day を求める
    '**************************
    ' 来月を識別

    TODAY_c = Range("G6")
    TODAY_mm = Month(DateAdd("m", 1, TODAY_c))

    ThisWorkbook.Worksheets("calc").Activate

    i = 3
    j = 1

    k = CALC.Range("A65536").End(xlUp).Row

    ' 配列Workdayにddを取り込む
    For i = 3 To CALC.Range("A65536").End(xlUp).Row
        If CALC.Cells(i, 2) = TODAY_mm Then
            Workday(j) = CALC.Cells(i, 5)
            j = j + 1
        End If
    Next i

    ' 1/2にddを入れ込む
    '*******************

    Worksheets(4).Activate

    i = 0
    j = 1
    k = 23

    While i < 10
        If Workday(j) <> "" Then
            Worksheets(4).Cells(k, 2) = "hoge-BANK-DAY" & Format(Workday(j), "dd")
            i = i + 1
            j = j + 1
            k = k + 1
        Else
            j = j + 1
        End If
    Wend

   

    ' 2/2にddを入れ込む
    '*******************

    Worksheets(5).Activate

    i = 0
    k = 21

    While j < 32
        If Workday(j) <> "" Then
            Worksheets(5).Cells(k, 2) = "hoge-BANK-DAY" & Format(Workday(j), "dd")
            i = i + 1
            j = j + 1
            k = k + 1
        Else
            j = j + 1
        End If
    Wend

    Worksheets(4).Activate

End Sub

-------------------------------------------------------------

←クリック一票

|

« スケジュール表作成(1) | Main | プリンタアイコンを消せなくする »

VBA」カテゴリの記事

Comments

Post a comment



(Not displayed with comment.)


Comments are moderated, and will not appear on this weblog until the author has approved them.



TrackBack


Listed below are links to weblogs that reference スケジュール表作成(2):

« スケジュール表作成(1) | Main | プリンタアイコンを消せなくする »