[[20100927215241]]　『印刷範囲の自動化？』（you）　ページの最後に飛ぶ

『印刷範囲の自動化？』（you）

 EXCEL2010 Windows7

 改ページプレビューで設定したページの、必要なページのみを印刷するマクロを
 教えてください。
 　
 条件は、

 行6より下に、一つでも入力のあるページは印刷する。というものです。

 よろしくお願いいたします。

 このあたりが参考になりますか？
　[[20100413102223]]　『データ表を印刷する時にページ数を印字させるには』（みく）
　[[20100823172154]]　『データの入っていないページを印刷しない方法』（みく）
　[[20090903081401]]　『自動印刷範囲』（ワクチン接種）

 （ｍｏｍｏ）

 momoさん、返事ありがとうございます。
 過去ログの内容、完全には理解していませんが、

 私の場合は、
 印刷範囲は設定しています。
 その中から、条件満たしたページのみを印刷するという感じです。

 マクロ初心者でして、全くわかりません。
 ご教授下さい。
 （you）

 具体的にどんな表でページ設定はどこで、どのような条件で印刷するのかを
 示してもらえますか？

 ６行目以降というのも曖昧でわかりません。
 ROWS(6)以降なのか、ページ毎の６行目以降なのか・・・とか

 本日は午後は出かけますので回答できません。
 （ｍｏｍｏ）

 あまり時間が無いので叩き台のみ提示してみます。

 入力されているセルのページ番号を取得するコードが鍵ですが
 以前に作成した汎用Functionを流用しています。

 標準モジュールで実行してください。

  Sub test()
  Dim myRng As Range, r As Range, c
  Application.ScreenUpdating = False
  With ActiveSheet
    Set myRng = Application.Intersect(.UsedRange, .Rows("6:" & .Rows.Count)).SpecialCells(xlCellTypeConstants)
  End With
  With CreateObject("Scripting.Dictionary")
    For Each r In myRng
      .Item(CellInPageNum(r)) = ""
    Next r
    For Each c In .Keys
      ActiveSheet.PrintOut From:=c, To:=c
    Next c
  End With
  Application.ScreenUpdating = True
  End Sub

  '指定セルのページ番号を取得する汎用Function
  Private Function CellInPageNum(myRng As Range) As Long
  Dim rngPrintStart As Range, rngBufPrintArea As Range
  Dim strPrintAreaBuckup As String
  Dim lngVPages As Long, lngHPages As Long, lngCellPages As Long
  If myRng Is Nothing Then
    CellInPageNum = 0
    Exit Function
  End If
  With myRng.Parent
    strPrintAreaBuckup = .PageSetup.PrintArea
    If strPrintAreaBuckup = "" Then
      Set rngPrintStart = .Range("A1")
    Else
      If Intersect(myRng, .Range(.PageSetup.PrintArea)) Is Nothing Then
        CellInPageNum = 0
        Exit Function
      End If
      Set rngPrintStart = .Range(.PageSetup.PrintArea).Cells(1)
    End If
    Set rngBufPrintArea = .Range(rngPrintStart, myRng)
    If rngBufPrintArea.Cells.Count > 1 Then
      lngVPages = .VPageBreaks.Count + 1
      lngHPages = .HPageBreaks.Count + 1
      .PageSetup.PrintArea = rngBufPrintArea.Address
      Select Case .PageSetup.Order
        Case xlDownThenOver
          lngCellPages = lngVPages * .HPageBreaks.Count + .VPageBreaks.Count + 1
        Case xlOverThenDown
          lngCellPages = .VPageBreaks.Count * lngHPages + .HPageBreaks.Count + 1
      End Select
      .PageSetup.PrintArea = strPrintAreaBuckup
    Else
      lngCellPages = 1
    End If
    CellInPageNum = lngCellPages
  End With
  Set rngPrintStart = Nothing
  Set rngBufPrintArea = Nothing
  End Function

 （ｍｏｍｏ）

コメント返信：

[ 一覧(最新更新順) ]

[[20100927215241]] 『印刷範囲の自動化？』（you） ページの最後に飛ぶ

[[20100927215241]]　『印刷範囲の自動化？』（you）　ページの最後に飛ぶ