3.3 社員番号を受け取り 資格テンプレートにデータをセットする
ウ.出力処理 の 第1段階で、該当データの抜き出しまで。
選ばれた社員のデータを読み込み、テンプレート資格.xls に ハメ込みます。
社員番号を受け取り、資格取得テーブルからデータを読み込みます。
※Excelを開いてセットは、まだで、データを取り出し デバッグで表示する
3.3.1 社員番号を受け取り、資格名称と資格取得日、資格証NOの取り出し
Subの関数、資格印刷(社員番号 as string) と、社員番号を受け取る関数を作ります。
次に、セットしたい資格名称と取得年月日、資格証NOを取り出します。
Private Sub 資格印刷(社員番号 As String) Dim strSQL As String strSQL = "select * from Q資格" strSQL = strSQL & " where 社員番号='" & 社員番号 & "'" Dim strRET As String Dim rs As New ADODB.Recordset rs.Open strSQL, CurrentProject.Connection, _ adOpenKeyset, adLockOptimistic 'ループ処理 If rs.RecordCount > 0 Then '資格が1つでもあったら(0件以上) While rs.EOF = False 'いつものEOFが偽の間 Debug.Print rs.Fields("資格名称") & " " & rs.Fields("取得年月日") & " " & rs.Fields("資格証NO") rs.MoveNext '次のレコードに移動しないと、とんでもないことに(笑) Wend End If rs.Close '開いたら閉じろ、ドアを開けたら閉めるってしつけられたでしょ(笑) Set rs = Nothing '変数も後始末しますか。使った器はキレイにしろって? End Sub
3.3.2 テンプレートファイルを開くマクロを追加します
取り出しの確認ができたら、Excelファイルを開くマクロを組み込みます。
AccessのデータをExcelへ転記する http://ken3hitori.g.hatena.ne.jp/bbs/2/14 を参考にしてください。
組み込むと、こんな感じになります。
Private Sub 資格印刷(社員番号 As String) Dim oApp As Object 'Excelアプリの参照用 Dim strWORK As String '文字編集用のワーク変数 Dim i As Integer Dim strMDBPATH As String 'MDBの保存場所、フォルダー・ディレクトリ Dim strXLSFILE As String 'テンプレートファイルの名前、e:\xxx\yyyy\テンプレート.xls 'Excelファイルを開く 'Accessの起動位置を取得 CurrentDb.NameにD:\xxxx\yyyy\zzz.mdbが入っている strWORK = CurrentDb.Name '後ろから1文字単位で¥を探す For i = Len(strWORK) To 1 Step -1 If Mid(strWORK, i, 1) = "\" Then Exit For '¥だったら抜ける Next i 'D:\xxxx\yyyy\zzz.mdb --> D:\xxxx\yyyy\ にする strMDBPATH = Mid(strWORK, 1, i) 'Excelの元ファイルの名前を作成 D:\xxxx\yyyy\ + テンプレート.xls strXLSFILE = strMDBPATH & "テンプレート資格.xls" 'ファイルの存在をチェックする If Dir(strXLSFILE) = "" Then MsgBox strXLSFILE & " の存在を 確認して下さい" Exit Sub 'エラーなので途中で抜ける End If Set oApp = CreateObject("Excel.Application") oApp.Visible = True 'Only XL 97 supports UserControl Property On Error Resume Next oApp.UserControl = True 'テンプレートファイルを開く oApp.Workbooks.Open Filename:=strXLSFILE 'テンプレートファイルをcopy 2009-11-28 追加 oApp.Windows("テンプレート資格.xls").Activate oApp.Sheets("資格").Select oApp.Sheets("資格").Copy oApp.Windows("テンプレート資格.xls").Activate oApp.ActiveWorkbook.Close Dim strSQL As String strSQL = "select * from Q資格" strSQL = strSQL & " where 社員番号='" & 社員番号 & "'" Dim strRET As String Dim rs As New ADODB.Recordset rs.Open strSQL, CurrentProject.Connection, _ adOpenKeyset, adLockOptimistic 'ループ処理 strRET = "" 'リターン値の初期化 If rs.RecordCount > 0 Then '資格が1つでもあったら(0件以上) While rs.EOF = False 'いつものEOFが偽の間 Debug.Print rs.Fields("資格名称") & " " & rs.Fields("取得年月日") & " " & rs.Fields("資格証NO") rs.MoveNext '次のレコードに移動しないと、とんでもないことに(笑) Wend End If rs.Close '開いたら閉じろ、ドアを開けたら閉めるってしつけられたでしょ(笑) Set rs = Nothing '変数も後始末しますか。使った器はキレイにしろって? End Sub
ここまでの操作動画: http://www.youtube.com/watch?v=Is7cBRHoQKM ※後半、実の親父と休みの件で会話してます。編集忘れましたミス(笑)
www.youtube.com
↑2:55 ぐらいから、Ken3の父親登場(笑)
続きは http://d.hatena.ne.jp/ken3memo/20091222/1261446901 を見てください。