[[20070201110006]]　『my Printの修正法』（悩める素人）　ページの最後に飛ぶ

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

　

『my Printの修正法』（悩める素人）ＸＰ　2003
マクロを使った印刷を行おうと「my Print」にたどり着き早速ダウンロードをして自分が使う書式にシート２を変更しようと思っています。その時に「my Print」の「Ｎｏ」欄を印刷したくない場合は、コードをどのように修正すればいいのでしょうか？
あともうひとつシート３を作り、「my Print」の例でいうと「排気量」で並び替え「排気量」毎に１ページに印刷し、それを全件のデータを一括印刷したいと考えています。
ただ、「排気量」毎に並び替えた時に１ページに収まらない場合は、２ページ目にうまく印刷されるのかという不安とコードが全く分からない状態で悩んでおります。どなたか親切に教えて下さる方、よろしくお願いします。 
 この文章からは、「my Print」を知らない人は、応えようがないでしょう。
「my Print」がフリーウエアーやシェアーウエアーなら、作者にたずねるのが
一番はやいと思います。誰か知ってる人がいいのですが・・・
　　　　　　　　　　（SHIOJII）
すみません説明不足でした。
「シート１」 
   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

となっています。 

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

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

 ＞「Ｎｏ」欄を印刷したくない場合
この点のヒントだけ。
MyPrint.xlsのSheet2のレイアウトを見ればどこにNoが表示されているか、
確認できると思います。
Worksheets("Sheet2").Range("B3").Value ・・・や
ws2.Range("B3").Value　・・・などとなっている行がそこへ値を投入するコードです。
　
(みやほりん)(-_∂)b
ということは、その欄を削除すればいいわけですね？
 通常はすぐに削除せず、行頭に　'　をつけてコメント化して、
動作を確かめます。（すぐに戻せるように）
不安なのは自信がないからです。
自信はノウハウの蓄積からのみ生じます。
ノウハウは経験からのみ得ることができます。
経験とはつまり、やってみることです。
(みやほりん)(-_∂)b

みやほりんさんありがとうございます。
さっそく「Worksheets("Sheet2").Range("B3").Value ・・・」や「ws2.Range("B3").Value　・・・」の行頭に「’」をつけてコメント化（緑色に変わりました）してみたのですが、うまく「№欄」の表示が消えません^^；他に何かあるのでしょうか？
 実行前にクリアしていないだけでは？
（セルB3をDELETEするコードはサンプルにはありません）
(みやほりん)(-_∂)b

そうでした。申し訳ないです。これからも勉強しながら頑張ってみます。
（悩める素人）
コメント返信：

[ 一覧(最新更新順) ]

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