社員名簿を作る ~その1の続きとなります。その1では、組織リストのデータベースをExcelマクロで作成しました。今回は、前回作成した組織リストデータベースと連動させた社員名簿を作成していきます。
8.今日現在の社員名簿を出力する
(1)社員基本情報シートの作成
社員基本情報シートは、生年月日、住所、電話番号等、様々な社員情報のうち履歴管理をしないマスター情報を管理するシートです。それでは早速つくっていきます。
①新規シートを作成する
シートタグの横にある「⊕」をクリックして新規シートを作成します。
②シート名を「社員基本情報」に変更する。
③A列からO列の見出しと見出しの内容に対応した全社員の基本情報を入力する(プログラムの関係上、見出しの名称と配置は変更しないでください)
(2)組織マスターシートに社員の異動に関連する項目を登録する
社員の異動に関連する項目(役割情報)として、今回は「雇用形態」「職掌」「格付1」「格付2」「役職」としました。また、名簿を整列させるために必要な項目にコードを付与します。
これらの項目を「組織マスター」シート1行目の(J列~R列)に配置します。また、それぞれの項目の内容を全て抽出し、2桁のコード(番号)を付します。
(3)異動DBシートの作成
①新規シートを作成する
②シート名を「異動DB」に変更する。
③A列からN列の見出しを入力する(プログラムの関係上、見出しの名称と配置は変更しないでください)
④「区分」は、今後、入社：1、異動：2、退職：3となりますが、今回は初期値の「0」を入力します。
⑤「開始日」は、直近のきりの良い日付を入力し、「終了日」は空欄にしておきます。
⑥「社員番号」~「役職」までの列見出しに応じた社員の役割情報を全て入力します。
(4)現在の社員名簿シートの作成
①新規シートを作成する
②シート名を「現在の社員名簿」に変更する。
③2行目のA列からAE列の項目(見出し)を入力する(プログラムの関係上、見出しの名称と配置は変更しないでください)
※項目は2行目に入力してください
(5)現在の社員名簿を出力するVBAコードを書く
①標準モジュールを開く(module2)
「開発」タグ → 「Visual Basic」を選択して「Visual Basic」を開く。
「Visual Basic」の「挿入」→「標準モジュール」を選択して「Module2」を作成する(Module1は組織関係のコード用でしたので、社員名簿関係のコード用としてModule2を準備します)
②①で作成したModule2に下記コードを記入(コピペ)する
Sub meibokosin(d As Date, c As Collection)
Dim kubun As Integer, today_d As Date, str_d As Date, end_d As Date
Dim no As Integer, syain_no As Integer, honbu As String, bu As String, ka As String, kakari As String, sosikicode As Long, _
koyo_keitai As String, koyo_keitai_code As Integer, syokusyou As String, kakuzuke1 As String, kakuzuke2 As String, kakuzuke_code As Long, _
yakusyoku As String, yakusyoku_code As Integer, simei As String, seibetu As String, seinengappi As Date, nenrei As Integer, ketuekigata As String, nyusyabi As Date, _
kinzokunensuu As Integer, yuubinbangou As String, jyuusyo As String, denwabangou As String, keitaibangou As String, _
mailadd As String, gakureki As String, kenpo_no As Integer, nenkin_no As Integer, kisonenkin_no As String
Worksheets("現在の社員名簿").Activate
n = Worksheets("現在の社員名簿").Cells(Rows.Count, 1).End(xlUp).Row
If n > 2 Then
Worksheets("現在の社員名簿").Range(Cells(3, 1), Cells(n, 31)).ClearContents
Worksheets("現在の社員名簿").Range(Cells(3, 1), Cells(n, 31)).Borders.LineStyle = xlLineStyleNone
End If
For m = 1 To c.Count
r = c(m)
With Worksheets("異動DB")
today_d = d
kubun = .Cells(r, 1)
str_d = .Cells(r, 2)
end_d = .Cells(r, 3)
no = r
syain_no = .Cells(r, 4)
simei = .Cells(r, 5)
honbu = .Cells(r, 6)
bu = .Cells(r, 7)
ka = .Cells(r, 8)
kakari = .Cells(r, 9)
koyo_keitai = .Cells(r, 10)
syokusyou = .Cells(r, 11)
kakuzuke1 = .Cells(r, 12)
kakuzuke2 = .Cells(r, 13)
yakusyoku = .Cells(r, 14)
End With
Set rcd = Worksheets("社員基本情報").Range("a:a").Find(syain_no, lookat:=xlWhole)
If Not rcd Is Nothing Then
seibetu = rcd.Offset(0, 2)
seinengappi = rcd.Offset(0, 3)
nenrei = Age(seinengappi, today_d)
ketuekigata = rcd.Offset(0, 4)
nyusyabi = rcd.Offset(0, 5)
kinzokunensuu = Age(nyusyabi, today_d)
yuubinbangou = rcd.Offset(0, 6)
jyuusyo = rcd.Offset(0, 7)
denwabangou = rcd.Offset(0, 8)
keitaibangou = rcd.Offset(0, 9)
mailadd = rcd.Offset(0, 10)
gakureki = rcd.Offset(0, 11)
kenpo_no = rcd.Offset(0, 12)
nenkin_no = rcd.Offset(0, 13)
kisonenkin_no = rcd.Offset(0, 14)
End If
With Worksheets("組織マスター")
Set rcd_honbu = .Range("a:a").Find(honbu, lookat:=xlWhole)
Set rcd_bu = .Range("c:c").Find(bu, lookat:=xlWhole)
Set rcd_ka = .Range("e:e").Find(ka, lookat:=xlWhole)
Set rcd_kakari = .Range("g:g").Find(kakari, lookat:=xlWhole)
sosikicode = rcd_honbu.Offset(0, 1) * 1000000 + rcd_bu.Offset(0, 1) * 10000 + rcd_ka.Offset(0, 1) * 100 + rcd_kakari.Offset(0, 1)
Set rcd_koyo_keitai = .Range("j:j").Find(koyo_keitai, lookat:=xlWhole)
koyo_keitai_code = rcd_koyo_keitai.Offset(0, 1)
Set rcd_kakuzuke1 = .Range("m:m").Find(kakuzuke1, lookat:=xlWhole)
Set rcd_kakuzuke2 = .Range("o:o").Find(kakuzuke2, lookat:=xlWhole)
kakuzuke_code = rcd_kakuzuke1.Offset(0, 1) * 100 + rcd_kakuzuke2.Offset(0, 1)
Set rcd_yakusyoku = .Range("q:q").Find(yakusyoku, lookat:=xlWhole)
yakusyoku_code = rcd_yakusyoku.Offset(0, 1)
End With
Dim arr() As Variant
If (kubun <> 3 And str_d <= today_d And today_d <= end_d) Or (str_d <= today_d And end_d = 0) Then
ReDim Preserve arr(30, p)
arr(0, p) = no
arr(1, p) = syain_no
arr(2, p) = honbu
arr(3, p) = bu
arr(4, p) = ka
arr(5, p) = kakari
arr(6, p) = sosikicode
arr(7, p) = koyo_keitai
arr(8, p) = koyo_keitai_code
arr(9, p) = syokusyou
arr(10, p) = kakuzuke1
arr(11, p) = kakuzuke2
arr(12, p) = kakuzuke_code
arr(13, p) = yakusyoku
arr(14, p) = yakusyoku_code
arr(15, p) = simei
arr(16, p) = seibetu
arr(17, p) = seinengappi
arr(18, p) = nenrei
arr(19, p) = ketuekigata
arr(20, p) = nyusyabi
arr(21, p) = kinzokunensuu
arr(22, p) = yuubinbangou
arr(23, p) = jyuusyo
arr(24, p) = denwabangou
arr(25, p) = keitaibangou
arr(26, p) = mailadd
arr(27, p) = gakureki
arr(28, p) = kenpo_no
arr(29, p) = nenkin_no
arr(30, p) = kisonenkin_no
p = p + 1
End If
Next m
With Worksheets("現在の社員名簿").Range("a3").Resize(p, 31)
.Value = Application.WorksheetFunction.Transpose(arr)
End With
n = Worksheets("現在の社員名簿").Cells(Rows.Count, 1).End(xlUp).Row
Set rcd_sosiki_code = Worksheets("現在の社員名簿").Range("2:2").Find("組織コード", lookat:=xlWhole)
Set rcd_koyo_keitai_code = Worksheets("現在の社員名簿").Range("2:2").Find("雇用形態コード", lookat:=xlWhole)
Set rcd_kakuzuke_code = Worksheets("現在の社員名簿").Range("2:2").Find("格付コード", lookat:=xlWhole)
Set rcd_yakusyoku_code = Worksheets("現在の社員名簿").Range("2:2").Find("役職コード", lookat:=xlWhole)
With Worksheets("現在の社員名簿")
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=rcd_sosiki_code, Order:=xlAscending
.Sort.SortFields.Add Key:=rcd_koyo_keitai_code, Order:=xlAscending
.Sort.SortFields.Add Key:=rcd_yakusyoku_code, Order:=xlAscending
.Sort.SortFields.Add Key:=rcd_kakuzuke_code, Order:=xlAscending
.Sort.SetRange .Range("A2:ae" & n)
.Sort.Header = xlYes
.Sort.Apply
End With
Worksheets("現在の社員名簿").Range("A2:ae" & n).Borders.LineStyle = xlContinuous
Worksheets("現在の社員名簿").Range("a1") = d & "現在社員名簿"
End Sub
Function Age(FromDate As Variant, ToDate As Variant) As Integer
Dim intAge As Integer
intAge = Year(ToDate) - Year(FromDate)
If Format(ToDate, "mmdd") < Format(FromDate, "mmdd") Then
intAge = intAge - 1
End If
Age = intAge
End Function(6)現在の社員名簿を出力するトリガーの設定
ブックを開いたときに常に今日現在の社員名簿を出力するように設定したいと思います。
5.(4)③ⅳで作成したModule1のsyokikaプロシージャを下記コードと差し替えてください。
Sub syokika()
Application.ScreenUpdating = False
Dim d As Date
d = Date
Dim c As Collection
Set c = New Collection
For i = 2 To Worksheets("異動DB").Cells(Rows.Count, 1).End(xlUp).Row
c.Add i
Next i
Call Module1.sosikikosin(d)
Call Module2.meibokosin(d, c)
Worksheets("menu").Activate
Application.ScreenUpdating = True
End Subこれで、一旦ブックをとじて、再び開くと、現在の組織リスト並びに現在の社員名簿が今日現在の日付で更新されます。
9.任意の日の社員名簿を出力する
ここまでで、「人事システム」ファイルを開いたときに、今日現在の社員名簿が自動的に作成されるようになりますが、今日現在の社員名簿ではなく、過去あるいは未来の特定の日の社員名簿を出力したいという場合もあります。そこで、任意の日の社員名簿を出力するための出力用フォームとそのプログラムコードを作成しています。
(1) 名簿の抽出条件を絞り込むためのフォームを作成する
①ユーザーフォームを作成する
社員名簿を出力する場合、常にすべての情報が必要となるわけではないので、必要な名簿リストのみを出力できるように、簡単な抽出条件を設定できるようにしてみたいと思います。
抽出条件としては、「部署」「役職」による絞り込み検索を実施します。また、必要な名簿リストの項目(住所・生年月日・年齢、等)を選択できるようにします。
まずは、抽出用のフォームをユーザーフォームで作成します。
「開発」タグ→「Visual Basic」を選択し、
「Visual Basic」の「挿入」タグ→「ユーザーフォーム」を選択して「ユーザーフォーム」を作成してください。
②ユーザーフォームに部品を配置する
ⅰ Visual Basicの「表示」タグ → 「ツールボックス」を選択し「ツールボックス」を表示させます。
ⅱ テキストボックス(基準日用)
まずは、基準日を入力するボックス(テキストボックス)を作成します。
ツールボックスからテキストボックスを選択し、ユーザーフォームの上でドラッグして適当な大きさに調整します。
ⅲ リストボックス(部署選択・役職選択・抽出項目選択用)
次に、抽出条件を選択するためのボックス(リストボックス)を配置します。
ツールボックスからリストボックスを選択し、ユーザーフォーム上でドラッグして適当な大きさに調整します。
リストボックスをあと2つ(計3つ)作成します。
ⅳ ラベルを付ける
テキストボックスとリストボックスの内容を表示するためのラベルを作成します。
ツールボックスのラベルを選択し、ドラッグして適当な大きさに調整します。
ラベル内でクリックしてカーソルを出現させた後「基準日(年/月/日)」と入力します。
リストボックスについても、同様にラベルを作成します。
ⅴ コマンドボタンの配置
次に出力用を実行するためのボタン(コマンドボタン)を作成します。
ツールボックスからコマンドボタンを選択し、ドラッグして適当な大きさに調整します。
ボタン上でクリックしてカーソルを出現させた後「出力」と入力する。
(2)名簿出力コードを入力する
①コードを入力するフォームモジュールを表示する
ユーザーフォームのコードはフォームモジュールに入力していきます。
「Visual Basic」の「UserForm1」→「コードの表示」を選択すると、右側にコードを入力するフォームモジュールが表示されます。
②リストボックスのアイテム(項目)を設定する
まずは、リストボックスにアイテム(項目)を設定します。フォームモジュールに下記コードを入力(コピペ)してください。
Private Sub UserForm_Initialize()
Dim i As Long
For i = 2 To Worksheets("組織マスター").Cells(Rows.Count, 1).End(xlUp).Row + 1
ListBox1.AddItem Worksheets("組織マスター").Cells(i, 1)
Next i
Dim j As Long
For j = 2 To Worksheets("組織マスター").Cells(Rows.Count, 17).End(xlUp).Row + 1
ListBox2.AddItem Worksheets("組織マスター").Cells(j, 17)
Next j
Dim k As Long
For k = 1 To Worksheets("現在の社員名簿").Cells(2, Columns.Count).End(xlToLeft).Column
ListBox3.AddItem Worksheets("現在の社員名簿").Cells(2, k)
Next k
End Sub試しに、実行してみます。実行ボタンをクリックしてください。
リストボックスに項目が表示されました。確認できたら右上の「×」をクリックして閉じてください。上手く行かない場合は、「組織マスター」シートのシート名および行・列の内容にズレがないかを確認下さい。
③名簿を出力するコードを入力する
フォームモジュールに下記コードを入力(コピペ)します。
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
With Worksheets("現在の社員名簿")
r = .Cells(Rows.Count, 1).End(xlUp).Row
If r > 2 Then
With .Range(.Cells(3, 1), .Cells(r, 31))
.ClearContents
.Borders.LineStyle = False
End With
End If
End With
Dim DB_Row As Long
Dim honbuset As Collection
Set honbuset = New Collection
For DB_Row = 2 To Worksheets("異動DB").Cells(Rows.Count, 1).End(xlUp).Row
Dim honbu As String
honbu = Worksheets("異動DB").Cells(DB_Row, 6)
Dim i As Long
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True And ListBox1.List(i) = honbu Then
honbuset.Add DB_Row
End If
Next i
Next DB_Row
Dim yakusyokuset As Collection
Set yakusyokuset = New Collection
Dim j As Long
For j = 1 To honbuset.Count
Dim yakusyoku As String
yakusyoku = Worksheets("異動DB").Cells(honbuset(j), 14)
For i = 0 To ListBox2.ListCount - 1
If ListBox2.Selected(i) = True And ListBox2.List(i) = yakusyoku Then
yakusyokuset.Add honbuset(j)
End If
Next i
Next j
Dim d As Date
d = TextBox1
Call Module2.meibokosin(d, yakusyokuset)
Dim TargetBook As Workbook
Worksheets("現在の社員名簿").Copy
Set TargetBook = ActiveWorkbook
ThisWorkbook.Activate
For r = ListBox3.ListCount - 1 To 0 Step -1
If ListBox3.Selected(r) = False Then
TargetBook.Worksheets("現在の社員名簿").Cells(1, r + 1).EntireColumn.Delete
End If
Next r
Call Module1.syokika
TargetBook.Activate
Unload Me
Application.ScreenUpdating = True
End Sub④ユーザーフォームを表示するコードを作成する
ⅰ メニューシートを表示する
ⅱ コマンドボタンを作成する
「開発」タグ → 「挿入」 → ActiveXコントロールの「コマンドボタン」を選択し、menuシート上でドラッグしてボタンを配置してください。
ボタンの名称を変更します。
ⅲ コマンドボタンを実行するコードを入力する
コマンドボタンを実行するコードは、menuシートのシートモジュールに記入します。
「Visual Basic」の「Sheet(menu)」をダブルクリックするとmenuシートのシートモジュールが開きます。
Private Sub CommandButton1_Click()
UserForm1.Show vbModeless
End Sub(3)任意の日の社員名簿を出力する
任意の日の社員名簿を実際に出力してみます。
①menuシートから「社員名簿の出力」のボタンをクリックする(このとき、開発タグの「デザインモード」がオンになっているとクリックできません)
②ユーザーフォームが表示される
③基準日を入力する(記入例：2021/7/1)※年月日以外の文字・記号を入力するとエラーとなります。
④リストボックスより出力したい項目を選択する(コントロールボタンを押しながら1つずつ選択するか、ドラッグしてまとめて選択することもできます)
※リストボックスのプロパティの設定(リストボックスで複数選択ができない場合はﾌﾟﾛﾊﾟﾃｨの設定が必要です)
⑤出力ボタンをクリックする
⑥リストが出力される
抽出した項目が出力されました。このとき、「人事システム」とは別のファイルに出力されます。
以上で、社員名簿の出力まで終了しました。次回(その3)は、異動の処理(入力)システムを作成していきます。
コメント