Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

8837 / 13646 ﾂﾘｰ

←次へ　｜　前へ→

▼

【30611】印刷について kori 05/10/31(月) 23:22

【30619】Re:印刷について とまと 05/11/1(火) 8:22

【30795】Re:印刷について End 05/11/4(金) 20:37

【30809】Re:印刷について End 05/11/4(金) 23:24

【30846】Re:印刷について kori 05/11/5(土) 22:42

【30847】Re:印刷について End 05/11/5(土) 22:51

【30848】Re:印刷について kori 05/11/5(土) 23:04

【30851】Re:印刷について End 05/11/5(土) 23:22

【30854】Re:印刷について End 05/11/6(日) 0:37

【30857】Re:印刷について とまと 05/11/6(日) 1:04

【30859】Re:印刷について End 05/11/6(日) 1:22

【30863】Re:印刷について とまと 05/11/6(日) 8:02

【30866】Re:印刷について kori 05/11/6(日) 11:33

【30869】Re:印刷について とまと 05/11/6(日) 13:17


	【30611】印刷について

kori - 05/10/31(月) 23:22 -


	引用なし

	パスワード

印刷についていつも困っているので質問します。
例えば
　　A　　　B　　　　C
1　名前　　住所　　電話番号
2　山田　　山田町　12-3456
3　田中　　田中町　1-23456
4 　鈴木　　鈴木町　123-456
　
といった表があるとします。Ａ４の用紙に印刷したい場合
このような表を印刷プレビューで表示するとなると、
左上の方に表示され、
設定で拡大縮小機能を使い大きくする必要があります。
しかしセルを大きくしたり拡大縮小機能や
改ページプレビューを使わずに
自分の入力したセルだけ
表示する方法があれば教えてください。


	【30619】Re:印刷について

とまと - 05/11/1(火) 8:22 -


	引用なし

	パスワード

おはようございます。
こんなんでどうかな。

Sub test()

Dim m As Long

With ActiveSheet.PageSetup
　.FitToPagesWide = 1
　.FitToPagesTall = 1
End With

m = 100
Do
m = m + 1
ActiveSheet.PageSetup.Zoom = m
If Application.ExecuteExcel4Macro("Get.Document(50)") > 1 Then Exit Do
Loop Until m = 400
ActiveSheet.PageSetup.Zoom = m - 1

End Sub


	【30795】Re:印刷について

End - 05/11/4(金) 20:37 -


	引用なし

	パスワード

▼kori さん：マルチポストより、放置は嫌いです。しかも表示なのか印刷なのか、わかんないです。考え方だけ。 Zoomの変動は、アタリをつけてそこから変動させたらどうですか？もとより正確にぴったりあわせる必要なければ5%ずつでも充分と思うけど。アタリをつけるなら　　Dim i As Long 　　With ActiveWindow 　　　　.Zoom = True 　　　　i = .Zoom 　　　　.Zoom = 100 　　End With 　　i = i * 1.1 'とか　　If i > 400 Then i = 400


	【30809】Re:印刷について

End - 05/11/4(金) 23:24 -


	引用なし

	パスワード

http://www2.moug.net/bbs/exvba/20051104000024.htm では追記。とまとさんのと組み合わせると。　　'Selectionに対して処理します。　　Dim i As Long 　　Application.ScreenUpdating = False 　　With ActiveWindow 　　　　.Zoom = True 　　　　i = .Zoom 　　　　.Zoom = 100 　　End With 　　i = i * 1.1 '←これは係数のつもりです。環境や用紙サイズで変動すると思われます。　　If i > 400 Then i = 400 　　With ActiveSheet 　　　　.DisplayPageBreaks = False 　　　　With .PageSetup 　　　　　　Application.DisplayAlerts = False 　　　　　　.PrintArea = Selection.Address 　　　　　　Application.DisplayAlerts = True 　　　　　　.Zoom = i 　　　　　　Do 　　　　　　　　If ExecuteExcel4Macro("Get.Document(50)") = 1 Then Exit Do 　　　　　　　　i = i - 5 　　　　　　　　.Zoom = i 　　　　　　Loop Until i < 10 '←てきとー　　　　End With 　　End With 　　Application.ScreenUpdating = True


	【30846】Re:印刷について

kori - 05/11/5(土) 22:42 -


	引用なし

	パスワード

とまとさんへ
この質問の記事をマルチポストしたことを謝ります。
申し訳ありませんでした。
>Sub test()
>Dim m As Long
>With ActiveSheet.PageSetup
>　.FitToPagesWide = 1
>　.FitToPagesTall = 1
>End With
>m = 100
>Do
>m = m + 1
>ActiveSheet.PageSetup.Zoom = m
>If Application.ExecuteExcel4Macro("Get.Document(50)") > 1 Then Exit Do
>Loop Until m = 400
>ActiveSheet.PageSetup.Zoom = m - 1
>End Sub

>とまとさんのと組み合わせると。
>
>　　'Selectionに対して処理します。
>　　Dim i As Long
>　　Application.ScreenUpdating = False
>　　With ActiveWindow
>　　　　.Zoom = True
>　　　　i = .Zoom
>　　　　.Zoom = 100
>　　End With
>　　i = i * 1.1 '←これは係数のつもりです。環境や用紙サイズで変動すると思われます。
>　　If i > 400 Then i = 400
>　　With ActiveSheet
>　　　　.DisplayPageBreaks = False
>　　　　With .PageSetup
>　　　　　　Application.DisplayAlerts = False
>　　　　　　.PrintArea ="$A$1:$C$4"
>　　　　　　Application.DisplayAlerts = True
>　　　　　　.Zoom = i
>　　　　　　Do
>　　　　　　　　If ExecuteExcel4Macro("Get.Document(50)") = 1 Then Exit Do
>　　　　　　　　i = i - 5
>　　　　　　　　.Zoom = i
>　　　　　　Loop Until i < 10 '←てきとー
>　　　　End With
>　　End With
>　　Application.ScreenUpdating = True
上記２つのコードを実行しました。
とまとさんのは１００％の倍率から１％増えていき、
Endさんのは４００％から５％ずつ減っていくのはわかりました。

個人的にはマクロの勉強になったのですが、
上司から拡大縮小機能を１００％のままでないと
注意されるので、どうしても仕事では使えそうにないです。
結局ＶＢＡでも拡大縮小機能を１００％のまま固定して、入力されたデータの分だけ画面に表示させるのは難しいんですか？


	【30847】Re:印刷について

End - 05/11/5(土) 22:51 -


	引用なし

	パスワード

▼kori さん：こんばんは。またまたわからなくなりました。 >入力されたデータの分だけ画面に表示させるのは難しいんですか？印刷？画面表示？印刷なら.Zoomいじらずに ActiveSheet.PageSetup.PrintArea = Selection.Address 画面表示なら、どうしたいのですか？入力範囲外をグレー表示？行列非表示ということ？


	【30848】Re:印刷について

kori - 05/11/5(土) 23:04 -


	引用なし

	パスワード

▼End さん：

>>入力されたデータの分だけ画面に表示させるのは難しいんですか？
>印刷？
>画面表示？
画面表示です。
>印刷なら.Zoomいじらずに
>ActiveSheet.PageSetup.PrintArea = Selection.Address
>
>画面表示なら、どうしたいのですか？
>入力範囲外をグレー表示？行列非表示ということ？
入力範囲外をグレー表示です。
質問が下手ですいません。


	【30851】Re:印刷について

End - 05/11/5(土) 23:22 -


	引用なし

	パスワード

▼kori さん：

ごめんなさい。
さっきちょっとコードアップしたのをご覧になられてたら、試さないでください。
EXCEL君が落ちます。（可能性があります）


	【30854】Re:印刷について

End - 05/11/6(日) 0:37 -


	引用なし

	パスワード

▼kori さん：とりあえず、落ち対策はしましたが、やっぱり不細工です。書いてるうちにあまり意味が見出せなくなったので、これくらいにしてください。 Sub サンプル() 　　Dim Rn As Long, Cn As Long 　　Application.ScreenUpdating = False 　　If TypeName(Selection) <> "Range" Then Exit Sub 　　With Selection 　　　　If .Areas.Count > 1 Then Exit Sub 　　　　Rn = .Cells(1).Row 　　　　Cn = .Cells(1).Column 　　　　If Rn > 1 Then Rows("1:" & Rn - 1).Hidden = True 　　　　Rows(Rn + .Rows.Count & ":65536").Hidden = True 　　　　If Cn > 1 Then Range(Columns(1), Columns(Cn - 1)).Hidden = True 　　　　Range(Columns(Cn + .Columns.Count), Columns(256)).Hidden = True 　　End With 　　Application.ScreenUpdating = True End Sub Sub 解除() 　　Application.ScreenUpdating = False 　　With Cells 　　　　.EntireColumn.Hidden = False 　　　　.EntireRow.Hidden = False 　　End With 　　Application.ScreenUpdating = True End Sub Sub 代案() 　　With ActiveSheet 　　　　Application.ScreenUpdating = False 　　　　.DisplayPageBreaks = False 　　　　With .PageSetup 　　　　　　Application.DisplayAlerts = False 　　　　　　.PrintArea = Selection.Address 　　　　　　Application.DisplayAlerts = True 　　　　　　.CenterHorizontally = True 　　　　　　.CenterVertically = True 　　　　　　.Orientation = xlLandscape 　　　　　　.PaperSize = xlPaperA4 　　　　　　.Zoom = 100 　　　　End With 　　　　Application.ScreenUpdating = True 　　　　.PrintPreview 　　End With End Sub


	【30857】Re:印刷について

とまと - 05/11/6(日) 1:04 -


	引用なし

	パスワード

▼kori さん：
こんばんは。

なんだかよく質問の意図がわからなかったので
はずれてるかなーと思いつつ回答した覚えが。。
あきらめずに最質問してみてください。
だめな時もあるけど。。(^^

Endさんご指摘ありがとー。(^^

>入力範囲外をグレー表示です。
これ改ページプレビューですよね。

Sub 拡大()
　　ActiveSheet.UsedRange.Select
　　ActiveWindow.View = xlPageBreakPreview
　　ActiveWindow.Zoom = True
End Sub

Sub 解除()
　　ActiveWindow.View = xlNormalView
End Sub

こんなんでどうかな？


	【30859】Re:印刷について

End - 05/11/6(日) 1:22 -


	引用なし

	パスワード

▼とまとさん：
こんばんは。
>Endさんご指摘ありがとー。(^^
いえいえ。お気になさらず。放置が嫌いなだけなので^ ^
遅くまでたいへんですね。私はそろそろ退却しますね。
（後お願いしちゃっていいですか？）

>改ページプレビューを使わずに
みたいです。

（追記）
とまとさんへ、もしかして誤解されてないですよね。念のため
>Zoomの変動は、アタリをつけてそこから変動させたらどうですか？
>もとより正確にぴったりあわせる必要なければ5%ずつでも充分と思うけど。
これはとまとさんへのレスじゃないですよ。
koriさんへ、工夫するとしたら、って意味でした。m(_ _)m


	【30863】Re:印刷について

とまと - 05/11/6(日) 8:02 -


	引用なし

	パスワード

おはようございます。 >（追記） >とまとさんへ、もしかして誤解されてないですよね。念のため >>Zoomの変動は、アタリをつけてそこから変動させたらどうですか？ >>もとより正確にぴったりあわせる必要なければ5%ずつでも充分と思うけど。 >これはとまとさんへのレスじゃないですよ。 >koriさんへ、工夫するとしたら、って意味でした。m(_ _)m 誤解して怒ってたりして^^ koriさん　 Endさんのも私のも試して、腑に落ちなければ　　　　　再質問してください。　　　　　（前レスが最質問になってました。どんな質問だろ？^^）　　　　　ではー。


	【30866】Re:印刷について

kori - 05/11/6(日) 11:33 -


	引用なし

	パスワード

Sub 代案()
　　With ActiveSheet
　　　　Application.ScreenUpdating = False
　　　　.DisplayPageBreaks = False
　　　　With .PageSetup・・・・１
　　　　　　Application.DisplayAlerts = False
　　　　　　.PrintArea = Selection.Address
　　　　　　Application.DisplayAlerts = True
　　　　　　.CenterHorizontally = True
　　　　　　.CenterVertically = True
　　　　　　.Orientation = xlPortrait
　　　　　　.PaperSize = xlPaperA4
　　　　　　.Zoom = 100
　　　　End With・・・・２
　　　　Application.ScreenUpdating = True
　　　　.PrintPreview
　　End With
End Sub
上記のEndさんのコードを試しました。
ステップ実行をおこなうと、
１から２のページ設定のコード範囲内はいいのですが
印刷プレビューで文字が小さく写ってしまいます。
やはりＶＢＡでも
セルの大きさを変えずに、また拡大縮小機能100％のまま
プレビュー画面の用紙一杯にデータを反映させるのは難しいのでしょうか？


	【30869】Re:印刷について

とまと - 05/11/6(日) 13:17 -


	引用なし

	パスワード

▼kori さん：こんにちは。

もとのシートのZoom倍率をうごかさなければいいのなら
仮のシートを作成してそこで倍率をかえれば、元のシート
の倍率を壊さずに済むと思います。
それで下記のように一時ファイル tmp を作成してそこで
倍率をいじってみました。これも上司の方に却下ですかね。

Sub 拡大2()

'tmpシートがあったら削除
　For Each ws In Worksheets
　　If ws.Name = "tmp" Then
　　 Application.DisplayAlerts = False
　　　 ws.Delete
　　 Application.DisplayAlerts = True
　　End If
　Next

'tmpのシートを追加
　　ActiveSheet.Copy after:=ActiveSheet
　　ActiveSheet.Name = "tmp"
　　
　　ActiveSheet.UsedRange.Select
　　ActiveWindow.View = xlPageBreakPreview
　　ActiveWindow.Zoom = True
　　
End Sub


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

8837 / 13646 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free