| 
    
     |  | ▼Kein さん: Kein さん、ごめんなさい m(_ _)m
 決して悪気があった訳ではないんです。
 Kein さんは、夜中にレスを頂ける物ですから、それまでの間に解決できる事は
 解決しておこうと思った訳です。
 この印刷範囲に関しても、別シートにコピーしたくなかったものですから、自分なりに書籍で調べて、範囲設定の ActiveSheet.PageSetup.PrintArea なる物を見つけたものですから、色々とトライしてみたのですが、うまく行かなかったので新規に質問した次第です。
 >印刷専用のシートを作ることですが、これが一番確実なやり方なのです。
 ActiveSheet.PageSetup.PrintArea を使って、何とかシートコピーせずに指定する方法はありませんか?
 >
 >Sub MySheet_Print()
 >  Dim PArea As Range
 >  Dim Sh As Worksheet
 >  Dim Ans As Integer
 >
 >  If Hck = False Then Exit Sub
 >  Set PArea = Range("B1", Range("B65536").End(xlUp)) _
 >  .Offset(, -1).Resize(, 5).SpecialCells(12)
 >  On Error Resume Next
 >  Set Sh = Worksheets("MyPrint")
 >  If Err.Number > 0 Then
 >   Set Sh = Worksheets _
 >   .Add(After:=Worksheets(Worksheets.Count)).Name = "MyPrint"
 >   Err.Clear
 >  End If
 >  Sh.Activete: Cells.Clear
 >  PArea.Copy Sh.Range("A1")
 >  ActiveSheet.PageSetUp.PrintArea = _
 >  Range("A1").CurrentRegion.Address
 >  Set PArea = Nothing: Set Sh = Nothing
 >  Ans = MsgBox("印刷を開始しますか", 36)
 >  If Ans = 6 Then ActiveSheet.PrintOut Copies:=1
 >End Sub
 >
 >自分で理解するように習慣づけで下さい。何から何まで人まかせではダメですよ。
 上記のように、自分なりに努力はしているつもりです。
 それと、上記のシートコピーのコードで"MyPrint"というシート名が付きませんでしたので、下記のように修正しました。
 
 >  Set Sh = Worksheets("MyPrint")
 >  If Err.Number > 0 Then
 >   Set Sh = Worksheets _
 >   .Add(After:=Worksheets(Worksheets.Count))
 >    Sh.Name = "MyPrint"
 >   Err.Clear
 >  End If
 
 また、前回と同じように'MyPrint'シートへのコピーで、行の高さなどがうまく
 コピーされません。
 何卒、よろしくお願いします。(次回以降は、元レス(18301)に戻ります)
 
 |  |