2017年6月
        1 2 3
4 5 6 7 8 9 10
11 12 13 14 15 16 17
18 19 20 21 22 23 24
25 26 27 28 29 30  

« ◆Excel VBA(定型フォーマットのExcelを一気に開いて複数作成するマクロ(第1回)) | トップページ | ¥Money(投信生活070526) »

2007年5月25日 (金)

◆Excel VBA(定型フォーマットのExcelを一気に開いて複数作成するマクロ(第2回))

今回は前回に引き続き定型フォーマットのExcelを一気に作成するマクロを提示します。
前回の仕様を実装したものが以下となります。仕様の詳細はこちらhttp://peiyorin.cocolog-nifty.com/blog/2007/05/excel_vba_7a7b.htmlをご覧ください。

'申請書フォーマット
Const cWsNm As String = "申請書"
Const f_部署cel As String = "C2"
Const f_申請者cel As String = "C4"
Const f_承認者cel As String = "C6"
Const f_承認日cel As String = "C8"
Const f_機能名cel As String = "C10"
Const f_依頼事項cel As String = "C12"

'管理表
Const cStRow As Integer = 3
Const 部署col As Integer = 2
Const 申請者col As Integer = 3
Const 承認者col As Integer = 4
Const 承認日col As Integer = 5
Const 機能名col As Integer = 6
Const 機能詳細col As Integer = 7
Const 依頼事項col As Integer = 8
Const 申請日col As Integer = 9

Sub 申請書生成()
    Const cDefPath As String = "c:\work"
    Const cMyWs As String = "管理表"
   
    Set oMyWs = ThisWorkbook.Sheets(cMyWs)
    Set oFormWs = ThisWorkbook.Sheets(cWsNm)
   
   
    'フォルダ指定
    ChDrive Left(cDefPath, 1)
    ChDir cDefPath
    FileDir = Application.GetSaveAsFilename("DUMMY", "Excelファイル(*.xls),*.xls", , "■■■ 保存先フォルダ指定 ■■■")
    If FileDir = "False" Or FileDir = "FALSE" Then Exit Sub
    FileDir = Mid(FileDir, 1, InStrRev(FileDir, "\") - 1)
   
   
    '申請書生成
    For Each oSel In Selection
        lRow = oSel.Row
        If oMyWs.Cells(lRow, 申請日col).Value <> "" Then GoTo next_oSel
       
        '申請書フォーマットコピー
        oFormWs.Copy
               
        '情報貼り付け
        Set oActWs = ActiveSheet
        a = oMyWs.Cells(lRow, 部署col).Value
        b = oMyWs.Cells(lRow, 申請者col).Value
        oActWs.Range(f_部署cel).Value = a
        oActWs.Range(f_申請者cel).Value = b
        oActWs.Range(f_承認者cel).Value = oMyWs.Cells(lRow, 承認者col).Value
        oActWs.Range(f_承認日cel).Value = oMyWs.Cells(lRow, 承認日col).Value
        oActWs.Range(f_機能名cel).Value = oMyWs.Cells(lRow, 機能名col).Value
        oActWs.Range(f_依頼事項cel).Value = oMyWs.Cells(lRow, 依頼事項col).Value
            
        oMyWs.Cells(lRow, 申請日col).Value = Now()
       
        ActiveWorkbook.SaveAs Filename:=FileDir & "\" & Format(Now(), "yyyymmddhhmmss") & "_" & a & "_" & b & ".xls"
       
next_oSel:
    Next

    Set oFormWs = Nothing
    Set oSel = Nothing
    Set oActWs = Nothing
    Set oMyWs = Nothing
   
End Sub

それでは解説していきます。
例のごとく、申請書用フォーマット、管理表の列番号やセル位置を定義してます。
モジュールですが、管理表シートおよび申請書フォーマットシートをオブジェクトにセットし、Application.GetSaveAsFilenameで申請書の保存先を指定するダイアログを表示します。デフォルトで表示するフォルダをcDefPathで定義しています。不要であれば削除してください。
For Each oSel In Selectionで予め選択した行数分処理を繰り返します。まず、処理対象行の申請日が空白でなければ処理を飛ばしています。これも無条件に申請書の再作成をする場合は削除してください。次に、申請書用フォーマットシートをコピーして、管理表の各項目を申請書の項目へ設定し、申請日に処理日を設定し、申請書を格納フォルダに保存して1件分の処理が完了です。
皆さんの仕事にあった形にカスタマイズしてご利用ください。
管理一覧.xlsをアップロードしておきますので、よかったらダウンロードしてみてください。

「kanri_sample.EXE」をダウンロード

以上で終了です。

次回から、私が作成したツールであるE2000Tools.xlsの機能について1日1つずつ1ヶ月くらいかけてご紹介していきます。きっと皆さんを便利にさせる機能があると思います。お楽しみに。ツール本体はこちらhttp://cat.zero.ad.jp/iizy/のDownloadからダウンロードできます。

« ◆Excel VBA(定型フォーマットのExcelを一気に開いて複数作成するマクロ(第1回)) | トップページ | ¥Money(投信生活070526) »

パソコン・インターネット」カテゴリの記事

コメント

コメントを書く

(ウェブ上には掲載しません)

« ◆Excel VBA(定型フォーマットのExcelを一気に開いて複数作成するマクロ(第1回)) | トップページ | ¥Money(投信生活070526) »