|
▼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)に戻ります)
|
|