エクセルだけで差し込み印刷(3-1)

エレガントなコードは書けないけど、仕事が簡単になればいいじゃないか？早く、自分にもどろう。

　3-1) 表示されているレコードをフォーマットに埋め込みレコード毎にbookを作成

　　　見えないものはBookを作りません、なのでbookを作りたくないときが非表示にするかフィルタを使ってください。
　　　　

エクセルのデータはリストシートに書く。

Ａ６から書き始める。　このセルを起点に使いマクロを動かす

６行目に書くのは項目、自由に変更可能

ひな形は　Format1　に作成　（　見た目なので好きに変更可能　）

リストシートの日付を　Ｆｏｒｍａｔ１のD10,D15,F15 Ｃｅｌｌに書き込んで　そのbookを 日付フォルダの中に作成します。　

カスタマイズするのに必要な知識はマクロの中のこの部分のみ

       'Format1 D10に リストの　A7の内容を移動

         .Range("D10").Value = ActiveCell.Offset(0, 0).Value

        'Format1 D12に リストのA7から指定セルを移動するために　上下方向0, 右方向に１移動

         .Range("D12").Value = ActiveCell.Offset(0, 1).Value

         .Range("F12").Value = ActiveCell.Offset(0, 2).Value

アクティブセル（エクセルで選択したセル）の内容をFormat1に書込む
起点となる　アクティブセルに対してどれだけ動かすか指定するのが
　　　　ActiveCell.Offset(0, 0)　：　　オフセットの指定は（上下、左右）　

動かしてみてください。Formatはあなたの美的センスでなんとでもなるでしょう。

エクセルファイルはここにあります

リリースして気が付いた、印刷機能がないですね。　book作成機能が欲しかったので
先に作っちゃいました。　印刷はたぶん簡単だと思う。


前へ  次へ

---

Sub book作成()

'画面のちらつきを防止する

Application.ScreenUpdating = False

'リストワークシートを選択する

Worksheets("リスト").Activate

'リストワークシートのセルB6をアクティブセルにする

Range("A6").Select

  

    'ユニークファイル番号の設定、ブックを作成するときの番号を１から順につけるために必要

    uFile = 0

    

    ' Save Directory の パス設定

    パス = ActiveWorkbook.Path '　カレントパスの取得

    SaveDir = パス & "\" & Format(Date, "yyyymmdd")

    ' カレントパス,日付のフォルダがある場合はフォルダ削除して再度作成

    If Dir(SaveDir, vbDirectory) <> "" Then

        Dim FSO As Object

         Set FSO = CreateObject("Scripting.FileSystemObject")

        FSO.DeleteFolder SaveDir

        Set FSO = Nothing

        MkDir SaveDir

    Else

        MkDir SaveDir

    End If

   

   'ループの開始

   Do

   'アクティブセルを１つ下に移動する　A7になる

   ActiveCell.Offset(1, 0).Select

   '空欄であれば、プログラムを終了する

   'Trim関数は前後のスペースを消去する

   If Trim(ActiveCell.Value) = "" Then

      Exit Do

   End If

   '非表示セルは対象としない

   If ActiveCell.EntireRow.Hidden = False Then

      'Format1 シートにリストの内容を繁栄される

       With Worksheets("Format1")

       'レコードの先頭セルを選択

       'Format1 D10に リストの　A7の内容を移動

         .Range("D10").Value = ActiveCell.Offset(0, 0).Value

        'Format1 D12に リストのA7から指定セルを移動するために　上下方向0, 右方向に１移動

         .Range("D12").Value = ActiveCell.Offset(0, 1).Value

         .Range("F12").Value = ActiveCell.Offset(0, 2).Value

         

       'レコードの最終セルであれば、Format１シートをsaveする

           Sheets("Format1").Select 'シートをアクティブにする

          ' ユニークファイル番号の設定

          uFile = uFile + 1

          

          '名前重複排除　別名を作成　フォーマットは　1-D12-F12.xls とする

          別名 = SaveDir & "\" & uFile & "-" & Range("D12") & "-" & Range("F12") & ".xls" 'パスと拡張子を付ける

          Sheets("Format1").Copy 'シートを新規ブックへコピー ※１

          ActiveWorkbook.SaveAs Filename:=別名, FileFormat:=XlFileFormat.xlExcel8   '別名を付けてブックを保存する

          ActiveWorkbook.Close '別名ブックを閉じる

          

          Sheets("リスト").Select  ' リストシートをアクティブにする

       

          End With

    End If

   'ループの終了

   Loop

End Sub