|
VBAで複数名分の勤怠表を一括で作ろうとしています。
シート1には、勤怠表を作成したいスタッフの名前を入力する用のシート(”入力用”)として、B19を一人目として、その下に複数名の名前を入れる予定です。
シート2には勤怠表のひな型を作っていて、そのシート2のI6に氏名欄があり、
シート1のB19以下に入力された名前を、シート1に作成したマクロボタンを押すと、1人1シートとして、ひな型のI6に氏名が自動で入力されるVBAを作ろうとしてます。
試しに作ったVBAだと、B19以下に複数名の名前を入力すると、その入力分だけひな型のI6にその氏名が入力された勤怠表が、1人1シートで、
出来あがるようになりましたが、
そのシート名が1,2,3,,,,と数字になってしまいます。
これを、数字ではなく、B19以下に入力した氏名もシート名になるように(I6に飛ばしたように、シート名も同様に)変更するには
どのコードを変えればいいか、分らなくなっています。
どうか助けて下さい。
以下は作成したコードです。
Option Explicit
Type St_set0
St As Object
Rw As Long
Rw_Staff As Long
C_item As Integer
C_Staff As Integer
End Type
Public St0 As St_set0
Type St_set1
St As Object
Rw As Long
Rw_Depart As Long
Rw_Staff As Long
C_Depart As Integer
C_Staff As Integer
End Type
Public St1 As St_set1
Sub Init()
Set St0.St = Sheets("入力用")
St0.C_item = 2
St0.C_Staff = 2
St0.Rw_Staff = 19
St1.Rw_Staff = 6
St1.C_Staff = 9
End Sub
Sub Test()
Dim I As Long
Init
St0.St.Select
St0.Rw = St0.Rw_Staff
Do Until St0.St.Cells(St0.Rw + I, St0.C_item) = ""
Sheets("ひな形").Select
Sheets("ひな形").Copy After:=Sheets(Sheets.Count)
Set St1.St = ActiveSheet
St1.St.Name = I + 1
St1.St.Cells(St1.Rw_Staff, St1.C_Staff) = St0.St.Cells(St0.Rw_Staff + I , St0.C_Staff)
I = I + 1
Loop
End Sub
Sub Clear_Sheets()
Dim I As Integer
Init
For I = Sheets.Count To 1 Step -1
If Sheets(I).Name <> "入力用" And Sheets(I).Name <> "ひな形" Then
Sheets(I).Select
Application.DisplayAlerts = False
Sheets(I).Delete
Application.DisplayAlerts = True
End If
Next I
St0.St.Select
End Sub
そして、別の標準モジュール2に
Sub Macro1()
'
' Macro1 Macro
'
'
Sheets("ひな形").Select
Sheets("ひな形").Copy After:=Sheets(2)
End Sub
お手数おかけしますが、
どうか教えて下さい
|
|