助けてください。印刷マクロを

質問

OS:XPSP2,Excel2002で印刷マクロを教えてください。
"入力シ－ト"に顧客管理用で下のようなデ－タが入っています。
　　　　　A列　　　　　B列　　　C列　
２行目：受付番号　　　氏名　　　住所;　・・・・・・S(列)
３行目　８０００１　　　玉田　　　　　　　　　　　　　　　　
　　　　　８０００２　　　山田
　　　　　８０００３　　　上田
　　　　　　・
　　　　　　・
受付番号はすでに85000くらい（不確定）まで入力済みです。
氏名以下をデ－タとして日々入力していき作成し、件数がかなり溜まった(数百件くらい)ときに印刷をするといった仕事です。
マクロを使って、印刷したいデ－タをMsgで”最初の番号を入力”で受付番号を入れて次に同じようにMsgで”印刷最後の番号を入力”で受付番号を入れて、その間のデ－タをA列からS列まで印刷するものです。

回答No.6

Wendy02 · ベストアンサー

こんばんは。Wendy02です。

こちらも読みました。すぐに書き込めなくて、新たな質問を出させてしまい、どうもすみませんでした。日付の範囲をマクロで入れることさえ分かれば、すぐに出来たのでした。

No.2853780 の変形版です。

Sub TestSample3()
　　'----- 印刷範囲 列指定 ---------
　　Const SHNAME As String = "入力シ－ト" '　　<----- シ－ト名指定
　　Const L_COL As Integer = 1 '"A" '　　<------ 印刷範囲の左端列
　　Const R_COL As Integer = 19 '"S" '　　<----- 印刷範囲の右端列
　　Const DATE_COL As Integer = 20 ' "T" '　<----- 印刷データ判定列（日付形式）
　　Const PREV_MODE As Integer = 1 '　　<----- 0 = 直接印刷 /　 1 = プレビュー
　　Const DT_FORMAT As String = "M月D日" '<-----印刷日の書式

　　Dim SearchWd1 As Variant
　　Dim SearchWd2 As Variant
　　Dim c1 As Range
　　Dim c2 As Range
　　Dim rw As Long
　　Dim LastCell As Range
　　Dim myPrintArea As Range
　　Dim myDate As Variant
　　Dim addmsg As String

　　myDate = Date '本日の日付
　　addmsg = Format$(myDate, DT_FORMAT) & "を" & vbCrLf
　　If MsgBox("印刷日は、" & Format$(myDate, DT_FORMAT) & "にしますがよろしいですか？", vbYesNo) = vbNo Then
　　　　Do
　　　　　　Application.SendKeys "{F2}"
　　　　　　Application.SendKeys "{HOME}"
　　　　　　myDate = Application.InputBox(addmsg & "変更してください。", "日付入力", _
　　　　　　Format$(myDate, DT_FORMAT), Type:=2)
　　　　　　If VarType(myDate) = vbBoolean Or myDate = "" Then Exit Sub
　　　　　　If IsDate(myDate) = False Then addmsg = "日付式が違います。" & vbCrLf
　　　　Loop While IsDate(myDate) = False

　　End If

　　　　　　With Worksheets(SHNAME)
　　　　　　　　If WorksheetFunction.CountA(.Range("A1").CurrentRegion) < 2 Then
　　　　　　　　　　MsgBox "データがありません。マクロを終了します", vbInformation: Exit Sub
　　　　　　　　End If

　　　　　　　　SearchWd1 = Application.InputBox("最初の【受付番号】を入力してください。", "番号入力", Type:=2)
　　　　　　　　If VarType(SearchWd1) = vbBoolean Or SearchWd1 = "" Then MsgBox "終了します。": Exit Sub

　　　　　　　　Set c1 = .Columns(L_COL).Find( _
　　　　　　　　What:=SearchWd1, _
　　　　　　　　LookIn:=xlValues, _
　　　　　　　　LookAt:=xlWhole, _
　　　　　　　　SearchOrder:=xlByColumns, _
　　　　　　　　MatchByte:=False)

　　　　　　　　If c1 Is Nothing Then
　　　　　　　　　　MsgBox SearchWd1 & " は、受付番号列からは見当たりません。" & vbCrLf & _
　　　　　　　　　　"終了します。", vbInformation
　　　　　　　　　　Exit Sub
　　　　　　　　End If
　　　　　　　　SearchWd2 = Application.InputBox("最後の【受付番号】を入力してください。", "番号入力", Type:=2)
　　　　　　　　If VarType(SearchWd2) = vbBoolean Or SearchWd2 = "" Then MsgBox "終了します。": Exit Sub

　　　　　　　　Set c2 = .Columns(L_COL).Find( _
　　　　　　　　What:=SearchWd2, _
　　　　　　　　LookIn:=xlValues, _
　　　　　　　　LookAt:=xlWhole, _
　　　　　　　　SearchOrder:=xlByColumns, _
　　　　　　　　MatchByte:=False)
　　　　　　　　If c2 Is Nothing Then
　　　　　　　　　　MsgBox SearchWd2 & " は、受付番号列からは見当たりません。" & vbCrLf & _
　　　　　　　　　　"終了します。", vbInformation
　　　　　　　　　　Exit Sub
　　　　　　　　End If

　　　　　　　　Set myPrintArea = .Range(c1, c2.Offset(, R_COL - 1))
　　　　　　　　　　If MsgBox("'" & myPrintArea.Address & "' の受付簿の印刷を開始します。" & _
　　　　　　　　　　　　"印刷日( " & Format(myDate, DT_FORMAT) & " )は、印刷と同時に、" & Chr(DATE_COL + 64) _
　　　　　　　　　　　　& "　列に設定されます。", vbOKCancel) = vbCancel Then
　　　　　　　　　　　　Exit Sub
　　　　　　　　 End If

　　　　　　　　'日付を入力
　　　　　　　　myPrintArea.Columns(DATE_COL).Resize(, 1).NumberFormatLocal = DT_FORMAT
　　　　　　　　myPrintArea.Columns(DATE_COL).Resize(, 1).Value = myDate

　　　　　　　　'"通知書”欄から"証券”欄までは印刷しない
　　　　　　　　.Range("K1:N1").EntireColumn.Hidden = True
　　　　　　　　.PageSetup.PrintArea = myPrintArea.Address
　　　　　　　　If PREV_MODE = 1 Then
　　　　　　　　　　.PrintOut Preview:=True
　　　　　　　　Else
　　　　　　　　　　UserForm2.Show vbModeless
　　　　　　　　　　DoEvents
　　　　　　　　　　.PrintOut Preview:=False

　　　　　　　　　　Unload UserForm2
　　　　　　　　　　MsgBox myDate & " 印刷分を " & myPrintArea.Rows.Count & "件印刷しました。", , "印刷完了"
　　　　　　　　End If
　　　　　　　　.PageSetup.PrintArea = ""

　　　　　　　　'印刷終了後"通知書”欄から"証券”欄まで再度表示
　　　　　　　　.Range("K1:N1").EntireColumn.Hidden = False

　　　　　　End With
　　　　　　Set c1 = Nothing: Set c2 = Nothing
　　　　　　Set myPrintArea = Nothing
End Sub

お礼

Wendy02さん　いつもありがとうございます。そしてお礼が遅くなりすみません。自分のパソコンでは考えていたように出来ましたが、職場へのコピーがまだできていませんので、なんとも言えませんが多分大丈夫だろうと思います。おかしかったときはまたお願いいたします。

回答No.5

myeyesonly

もう一つの可能性を考えてみました。
これは印刷したい範囲を選択して、選択した範囲を印刷する、という形に変えたものです。
これだと、printout 命令の対象が range から、選択範囲を意味する selection になるので、先のエラーが出ないかもしれません。

それから、印刷したい範囲の大きさが大体決まってる場合は、例えば 100行なら、
y2 = InputBox("最後の行番号", "印刷範囲の", y1+100)
にすると、自動的に 100行分の数字が出ます。

Sub 印刷()

y1 = InputBox("最初の行番号", "印刷範囲の", 1)
y2 = InputBox("最後の行番号", "印刷範囲の", y1)

Range(Cells(y1, 1), Cells(y2, 19)).select
selection.printout

End Sub

回答No.4

myeyesonly

トラぶってるみたいですね。m(__)m
まず、後からの inputbox に最初のデータが出てくるのは、意図的にそういう風にした為です。
y2 = InputBox("最後の行番号", "印刷範囲の", y1)
の部分の y1 を空欄にすれば、出なくなります。
y2 = InputBox("最後の行番号", "印刷範囲の", )

こんな事をした理由は、シートの途中から印刷する場合、y1 より小さい数字だと範囲がエラーになるかな？と考えたからです。
表示されたデータが選択されているはずなので、そのまま数字を打ち込めばいいはずです。

それから、オブジェクト・・・の件ですが、Excel2000 ではちゃんと動きますので、マクロの書式が、Excel2002 で変わったのかもしれません。

私は 2002 を持ってないので、直接この回答が出来ませんが、
ツール→マクロ→新しいマクロの記録
で、マクロ記録モードにして、シートの適当な範囲を選択し、
ファイル→印刷
で「指定した部分を印刷」にチェックして、「ＯＫ」してみてください。
そして、マクロ記録ボックスの終了ボタンをクリックするか、もしくは
ツール→マクロ→記録終了
をやります。

プリンタをオフにしておけば、紙は出てきませんので、プリンタマークをダブルクリックで印刷を中止できます。

そして、新しく記録されたマクロのモジュールを開いて見て、printout 部分がどういう風に記録されているか見て修正できるかもしれません。

おそらく range オブジェクトの前に何かつくのではないかと思います。
activeworkbook.sheets("sheet1").range("a1:c5")
みたいな感じでしょうか。この通りなら、
activeworkbook.sheets("sheet1").Range(Cells(y1, 1), Cells(y2, 19)).printout
で出来ると思います。

これでダメだったら・・・ちょっと私にはお手上げになります。m(__)m
2000 と 2002 でマクロまで変わってたんですね。(^^;

補足

いろいろありがとうございます。
＞ツール→マクロ→新しいマクロの記録　これでやったコ－ドは
Sub Macro8()
Sheets("入力シ－ト").Select
Range("A2:S75").Select
Selection.PrintOut Copies:=1, Collate:=True
End Sub
になりました。

回答No.3

myeyesonly

あ～もう何やってんだか。m(__)m

Sub 印刷()

y1 = InputBox("最初の行番号", "印刷範囲の", 1)
y2 = InputBox("最後の行番号", "印刷範囲の", y1)

Range(Cells(y1, 1), Cells(y2, 19)).printout

End Sub

最後の命令が、select の訳ないですよね。
printout に修正しました。

何度も失礼いたしました。m(__)m

補足

myeyesonlyさん早々の回答ありがとうございます。
＞Range(Cells(y1, 1), Cells(y2, 19)).printout
実行時エラ－’１００４　アプリケ－ション定義またはオブジェクト定義エラ－になります。
後からのインプットボックス入力の際前の番号が残ったままですが？

回答No.2

myeyesonly

すいません。
修正前のを書いてしまいました。m(__)m

Sub 印刷()

y1 = InputBox("最初の行番号", "印刷範囲の", 1)
y2 = InputBox("最後の行番号", "印刷範囲の", y1)

Range(Cells(y1, 1), Cells(y2, 19)).Select

End Sub

が正しいです。
msgbox ではなく、inputbox になります。

回答No.1

myeyesonly

こんにちは。
以下のマクロでいかがでしょう。

sub 印刷()
y1 = msgbox("最初の行番号","印刷範囲の",1)
y2 = msgbox("最後の行番号","印刷範囲の",y1)
range(cells(y1,1),cells(y2,19)).printout
end sub

Excel2000 にて動作を確認しました。
印刷用紙設定、書式、升目の幅などはあらかじめ調整しておく必要があります。
私はこういう時は、マクロをキーボードショートカットに登録しておきます。

エクセルワークシートのウィンドウから「ツール」→「マクロ」→「マクロ」のウィンドウで、該当するマクロを選択して「オプション」をクリックします。

もしくは、そのワークシートのどこかにクリップアートでも貼り付けて、右クリック→マクロを登録で、クリップアートにマクロを登録しておくのも便利です。