こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

再)excel2000VBAで用紙の上半分部分のみ連続印刷する

ここで教えていただいた、コードを実行したところ見事連続印刷できましたが、シートの上半分が10枚に印刷されます。10枚だと用紙がもったいないので、2シートづつA4で5枚に収めて印刷したいです。それにはどうしたらよろしいか。ご教示お願いします。

Sub TesSample()
Dim mySh As Variant
'請求書一括印刷
mySh = Array("AAA", "BBB", "CCC", "DDD", "EEE", "FFF", "GGG", "EEE", "FFF", "GGG")

Worksheets(mySh).Select
Worksheets(mySh).PrintPreview
Worksheets("hyousi").Select
End Sub

投稿日時 - 2005-11-14 16:59:35

QNo.1778650

すぐに回答ほしいです

質問者が選んだベストアンサー

こんばんは。Wendy02です。

このマクロは、前々回からの続きのマクロを直したものです。プロテクトは、パスワードは後でつけてください。
確か、プリンタの吐き出しを制御する方法があったはずですが、今、私の所のプリンタはありませんもので、実験が出来ません。それから、これは、縮小されたものか、B4サイズの紙のようですね。そうでないと、64行までは印刷できませんから。

Sub BillsTotalPrintProc2()
  '請求書一括印刷
  Dim mySh As Variant
  Dim i As Long
  Application.ScreenUpdating = False
  '請求印刷面のデータの削除
  Worksheets("請求印刷 (2)").UsedRange.Clear
  '開始
  mySh = Array("A", "B", "C", "D", "E", "F", "G", "I", "J")
  For i = LBound(mySh) To UBound(mySh)
    Worksheets(mySh(i)).Unprotect 'プロテクトを外す
    Worksheets(mySh(i)).Range("B2:AB32").Copy _
    Worksheets("請求印刷 (2)").Cells((i + 1) + 32 * i, 1)
    Worksheets(mySh(i)).Protect  'プロテクトを掛ける
  Next
  Application.CutCopyMode = False
 
  Worksheets("請求印刷 (2)").PrintPreview
  Application.ScreenUpdating = True
  Sheets("hyousi").Select
End Sub

'---------------------------------
'既に設定済みの場合は、以下は入りません。行の高さ-列の幅をコピーするマクロです。
'ハングしたかと思うほど、ひじょうに時間が掛かります。すでに、セルの高さ・幅が設定されていたら、これは必要ありません。

Sub PrintPageSetting()
  '印刷ページ設定
  Dim myRowsData As Variant
  Dim myColumnsData As Variant
  Dim i As Integer
  Dim j As Integer
  Dim k As Integer
  'コピーされたシートの数
  Const SH_COUNT = 10
  Application.ScreenUpdating = False
  With Worksheets("A").Range("B2:AB32")
   ReDim myRowsData(1 To .Rows.Count)
   ReDim myColumnsData(1 To .Columns.Count)
   For i = 1 To .Rows.Count
     myRowsData(i) = .Cells(i, 1).RowHeight
   Next
   For j = 1 To .Columns.Count
     myColumnsData(j) = .Cells(1, j).ColumnWidth
   Next
   For j = 1 To .Columns.Count
     Worksheets("請求印刷 (2)").Cells(1, j).ColumnWidth _
      = myColumnsData(j)
   Next
   For k = 1 To SH_COUNT:  For i = 1 To .Rows.Count
     Worksheets("請求印刷 (2)").Cells(i + (SH_COUNT - 1) * 32, 1).RowHeight _
      = myRowsData(i)
     Next:  Next
   End With
   
   Application.ScreenUpdating = True
End Sub

投稿日時 - 2005-11-14 18:27:57

お礼

あありがとうございました。完璧にできました。
なんとお礼をもうしていいか言葉がみつかりません。
私の質問にこんなにも労力を使っていただいて恐縮しています。ただただ感謝のきもちです。
おっしゃるとおり、自分の作ったものを見たら85%に縮小されていたので、そのように変更したらばっちりでした。これからもご指導よろしくお願いします。

投稿日時 - 2005-11-14 20:00:13

ANo.1

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(1)

あなたにオススメの質問