3.3.4 エラー処理を入れる マスターの設定方法を少し説明
oApp.range(rs.Fields("資格名称")).Offset(0, 1) = rs.Fields("取得年月日")
でデータをセットしているので、
資格名称がテンプレートに見つからない時の処理を入れます。
と言っても、最終的に手抜きで
On Error Resume Next
でエラーを無視しただけです(ぉぃぉぃ)
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") On Error Resume Next 'エラーを無視 oApp.range(rs.Fields("資格名称")).Offset(0, 1) = rs.Fields("取得年月日") oApp.range(rs.Fields("資格名称")).Offset(0, 2) = rs.Fields("資格証NO") rs.MoveNext '次のレコードに移動しないと、とんでもないことに(笑) Wend End If rs.Close '開いたら閉じろ、ドアを開けたら閉めるってしつけられたでしょ(笑) Set rs = Nothing '変数も後始末しますか。使った器はキレイにしろって? End Sub
詳細はドタバタ動画 : http://www.youtube.com/watch?v=t44aB8bgbl0 を見てください。
www.youtube.com