[[20070201110006]] 『my Printの修正法』(悩める素人) >>BOT

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『my Printの修正法』(悩める素人)XP 2003
マクロを使った印刷を行おうと「my Print」にたどり着き早速ダウンロードをして自分が使う書式にシート2を変更しようと思っています。その時に「my Print」の「No」欄を印刷したくない場合は、コードをどのように修正すればいいのでしょうか?
あともうひとつシート3を作り、「my Print」の例でいうと「排気量」で並び替え「排気量」毎に1ページに印刷し、それを全件のデータを一括印刷したいと考えています。
ただ、「排気量」毎に並び替えた時に1ページに収まらない場合は、2ページ目にうまく印刷されるのかという不安とコードが全く分からない状態で悩んでおります。どなたか親切に教えて下さる方、よろしくお願いします。

 この文章からは、「my Print」を知らない人は、応えようがないでしょう。
「my Print」がフリーウエアーやシェアーウエアーなら、作者にたずねるのが
一番はやいと思います。誰か知ってる人がいいのですが・・・
          (SHIOJII)

すみません説明不足でした。
「シート1」
   A           B           C                   D         E       F
1  No	メーカー	       車名	         年式	排気量	価格(万)
2  1	シボレー	       カマロ	         1990	5700	150
3  2	ダッジ	       バイパー	         1999	8000	1150
4  3	キャデラック    フリートウッド	1993	5700	180
5  4	フォード	       マスタング	         1995	5000	160
6  5	シボレー	       コルベット	         2003	5700	645
7  6	リンカーン      タウンカー	         1994	4600	225
8  7	プリマス	       クーダ	         1970	7210	370
9  8	ダッジ	       チャレンジャー	1974	7210	380
10 9	ポンティアック  ファイアーバード	1990	5700	120

というような表に対してコードが
Private Sub CommandButton1_Click() '指定プリント
Dim PrintMenu As Long
Dim i As Long

With Worksheets("Sheet1")

    i = Application.InputBox("No.を入力して下さい。", "指定プリント", Type:=1)

    If i = 1 Or i > .Range("A65536").End(xlUp).Row - 1 Then
        MsgBox "該当するNo.は、ありません。終了します。", 48
        Exit Sub
    ElseIf i = 0 Then
        Exit Sub
    End If

        Worksheets("Sheet2").Range("B3").Value = .Cells(i + 1, 1).Value
        Worksheets("Sheet2").Range("C6").Value = .Cells(i + 1, 2).Value
        Worksheets("Sheet2").Range("C9").Value = .Cells(i + 1, 3).Value
        Worksheets("Sheet2").Range("E6").Value = .Cells(i + 1, 4).Value
        Worksheets("Sheet2").Range("E9").Value = .Cells(i + 1, 5).Value
        Worksheets("Sheet2").Range("C3").Value = .Cells(i + 1, 6).Value

        Worksheets("Sheet2").Select

PrtMsg:

  PrintMenu = MsgBox("印刷を実行してもいいですか?。" & Chr(13) & _
                  " [は い]   : 印刷実行" & Chr(13) & _
                  " [いいえ]   : 印刷プレビュー" & Chr(13) & _
                  " [キャンセル] : 終了", 3, "指定印刷")

        If PrintMenu = 6 Then 'はい(印刷実行)
             MsgBox "印刷します。"
             Worksheets("Sheet2").PrintOut

        ElseIf PrintMenu = 7 Then 'いいえ(印刷プレビュー)
             Worksheets("Sheet2").PrintPreview
             GoTo PrtMsg  'プレビューを閉じた後、確認メッセージに戻る。

        ElseIf PrintMenu = 2 Then 'キャンセル(何もしない)

        End If

End With
End Sub

Private Sub CommandButton2_Click() '連続プリント
Dim PrintMenu As Long
Dim i As Long

With Worksheets("sheet1")

    For i = 2 To .Range("A65536").End(xlUp).Row
        Worksheets("Sheet2").Range("B3").Value = .Cells(i, 1).Value
        Worksheets("Sheet2").Range("C6").Value = .Cells(i, 2).Value
        Worksheets("Sheet2").Range("C9").Value = .Cells(i, 3).Value
        Worksheets("Sheet2").Range("E6").Value = .Cells(i, 4).Value
        Worksheets("Sheet2").Range("E9").Value = .Cells(i, 5).Value
        Worksheets("Sheet2").Range("C3").Value = .Cells(i, 6).Value

        Worksheets("Sheet2").Select

PrtMsg:

  PrintMenu = MsgBox("印刷を実行してもいいですか?。" & Chr(13) & _
                  " [は い]   : 印刷実行" & Chr(13) & _
                  " [いいえ]   : 印刷プレビュー" & Chr(13) & _
                  " [キャンセル] : 次を読込", 3, "連続印刷")

        If PrintMenu = 6 Then 'はい(印刷実行)
             MsgBox "印刷します。"
             Worksheets("Sheet2").PrintOut

        ElseIf PrintMenu = 7 Then 'いいえ(印刷プレビュー)
             Worksheets("Sheet2").PrintPreview
             GoTo PrtMsg  'プレビューを閉じた後、確認メッセージに戻る。

        ElseIf PrintMenu = 2 Then 'キャンセル(何もしない)

        End If

    Next i

End With
End Sub

Private Sub CommandButton3_Click() '一括プリント
Dim i As Long

        If vbNo = MsgBox("印刷を実行してもいいですか?。", 4, "一括印刷") Then Exit Sub

With Worksheets("sheet1")

    Worksheets("Sheet2").Select

    For i = 2 To .Range("A65536").End(xlUp).Row
        Worksheets("Sheet2").Range("B3").Value = .Cells(i, 1).Value
        Worksheets("Sheet2").Range("C6").Value = .Cells(i, 2).Value
        Worksheets("Sheet2").Range("C9").Value = .Cells(i, 3).Value
        Worksheets("Sheet2").Range("E6").Value = .Cells(i, 4).Value
        Worksheets("Sheet2").Range("E9").Value = .Cells(i, 5).Value
        Worksheets("Sheet2").Range("C3").Value = .Cells(i, 6).Value

        Worksheets("Sheet2").PrintOut
    Next i

End With
End Sub

Private Sub CommandButton4_Click() 'フィルタ印刷
Dim PrintMenu As Long
Dim r As Range
Dim ws2 As Worksheet

With Worksheets("sheet1")

    Set ws2 = Worksheets("Sheet2")

    For Each r In .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible)
        If r.Row > 1 Then
            ws2.Range("B3").Value = .Cells(r.Row, 1).Value
            ws2.Range("C6").Value = .Cells(r.Row, 2).Value
            ws2.Range("C9").Value = .Cells(r.Row, 3).Value
            ws2.Range("E6").Value = .Cells(r.Row, 4).Value
            ws2.Range("E9").Value = .Cells(r.Row, 5).Value
            ws2.Range("C3").Value = .Cells(r.Row, 6).Value

            Worksheets("Sheet2").Select

PrtMsg:

        PrintMenu = MsgBox("印刷を実行してもいいですか?。" & Chr(13) & _
                  " [は い]   : 印刷実行" & Chr(13) & _
                  " [いいえ]   : 印刷プレビュー" & Chr(13) & _
                  " [キャンセル] : 次を読込", 3, "フィルタ印刷")

            If PrintMenu = 6 Then 'はい(印刷実行)
                 MsgBox "印刷します。"
                 Worksheets("Sheet2").PrintOut
            ElseIf PrintMenu = 7 Then 'いいえ(印刷プレビュー)
                 Worksheets("Sheet2").PrintPreview
                 GoTo PrtMsg  'プレビューを閉じた後、確認メッセージに戻る。
            ElseIf PrintMenu = 2 Then 'キャンセル(何もしない)
            End If

        End If
    Next r

End With
End Sub

'コントロールツールボックスのコマンドボタンだと
'ボタンを押したときに選択が解除されてしまうので、
'フォームのボタンを使用。
Sub Form_Button1_Click() '行選択プリント
Dim PrintMenu As Long
Dim r As Range
Dim ws1 As Worksheet, ws2 As Worksheet

    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")

    With ws1
        ActiveCell.Activate

        For Each r In Selection

            If r.Row > 1 And .Range("A65536").End(xlUp).Row >= r.Row Then

                ws2.Range("B3").Value = .Cells(r.Row, 1).Value
                ws2.Range("C6").Value = .Cells(r.Row, 2).Value
                ws2.Range("C9").Value = .Cells(r.Row, 3).Value
                ws2.Range("E6").Value = .Cells(r.Row, 4).Value
                ws2.Range("E9").Value = .Cells(r.Row, 5).Value
                ws2.Range("C3").Value = .Cells(r.Row, 6).Value

                ws2.Select

PrtMsg:

                  PrintMenu = MsgBox("印刷を実行してもいいですか?。" & Chr(13) & _
                            " [は い]   : 印刷実行" & Chr(13) & _
                            " [いいえ]   : 印刷プレビュー" & Chr(13) & _
                            " [キャンセル] : 次を読込", 3, "フィルタ印刷")

                    If PrintMenu = 6 Then 'はい(印刷実行)
                         MsgBox "印刷します。"
                         Worksheets("Sheet2").PrintOut
                    ElseIf PrintMenu = 7 Then 'いいえ(印刷プレビュー)
                         Worksheets("Sheet2").PrintPreview
                         GoTo PrtMsg  'プレビューを閉じた後、確認メッセージに戻る。
                    ElseIf PrintMenu = 2 Then 'キャンセル(何もしない)
                    End If

            End If
    Next r

    End With
End Sub

となっています。


 復元しました。
 書き込みは消さないようにb
 (ROUGE)

 一応情報として提示しておきます。
INAさん作成のサンプルブックです。
なお、修正が必要な箇所も下記に提示しております。
[[20030213173530]]『エクセルで差込印刷をする方法は?』(jobanni) 
(みやほりん)(-_∂)b

 >「No」欄を印刷したくない場合
この点のヒントだけ。
MyPrint.xlsのSheet2のレイアウトを見ればどこにNoが表示されているか、
確認できると思います。
Worksheets("Sheet2").Range("B3").Value ・・・や
ws2.Range("B3").Value ・・・などとなっている行がそこへ値を投入するコードです。
 
(みやほりん)(-_∂)b

ということは、その欄を削除すればいいわけですね?

 通常はすぐに削除せず、行頭に ' をつけてコメント化して、
動作を確かめます。(すぐに戻せるように)
不安なのは自信がないからです。
自信はノウハウの蓄積からのみ生じます。
ノウハウは経験からのみ得ることができます。
経験とはつまり、やってみることです。
(みやほりん)(-_∂)b


みやほりんさんありがとうございます。
さっそく「Worksheets("Sheet2").Range("B3").Value ・・・」や「ws2.Range("B3").Value ・・・」の行頭に「’」をつけてコメント化(緑色に変わりました)してみたのですが、うまく「w刀vの表示が消えません^^;他に何かあるのでしょうか?

 実行前にクリアしていないだけでは?
(セルB3をDELETEするコードはサンプルにはありません)
(みやほりん)(-_∂)b


そうでした。申し訳ないです。これからも勉強しながら頑張ってみます。
(悩める素人)

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.