Excel VBA質問箱 IV

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

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


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

7417 / 13644 ﾂﾘｰ

←次へ　｜　前へ→

▼

【38650】改ページする行の取得方法 akko 06/6/7(水) 19:22

【38656】Re:改ページする行の取得方法 ichinose 06/6/8(木) 6:55

【38667】Re:改ページする行の取得方法 akko 06/6/8(木) 10:18

【38707】Re:改ページする行の取得方法 ichinose 06/6/8(木) 20:00

【38718】Re:改ページする行の取得方法 Ned 06/6/8(木) 22:53

【38731】Re:改ページする行の取得方法 akko 06/6/9(金) 9:42

【38739】Re:改ページする行の取得方法 ichinose 06/6/9(金) 11:02

【38746】Re:改ページする行の取得方法 akko 06/6/9(金) 11:36

【38749】Re:改ページする行の取得方法 ichinose 06/6/9(金) 11:56

【38751】Re:改ページする行の取得方法ほかには ichinose 06/6/9(金) 12:25

【38753】Re:改ページする行の取得方法 akko 06/6/9(金) 13:44

【38754】Re:改ページする行の取得方法 akko 06/6/9(金) 14:01

【38756】Re:改ページする行の取得方法 ichinose 06/6/9(金) 14:58

【38759】Re:改ページする行の取得方法 ハチ 06/6/9(金) 15:58

【38760】Re:改ページする行の取得方法 akko 06/6/9(金) 16:20

【38765】Re:改ページする行の取得方法 ハチ 06/6/9(金) 17:01

【38770】Re:改ページする行の取得方法 ichinose 06/6/9(金) 18:19

【38849】Re:改ページする行の取得方法 akko 06/6/12(月) 18:22

【38851】Re:改ページする行の取得方法 ichinose 06/6/12(月) 19:04

【38878】Re:改ページする行の取得方法 akko 06/6/13(火) 14:56

【38897】Re:改ページする行の取得方法 ichinose 06/6/13(火) 22:53

【38931】Re:改ページする行の取得方法 akko 06/6/14(水) 18:03

【38937】Re:改ページする行の取得方法 ichinose 06/6/14(水) 21:33

【38938】Re:改ページする行の取得方法　追伸 ichinose 06/6/14(水) 21:40

【38951】Re:改ページする行の取得方法　追伸 ハチ 06/6/15(木) 9:18

【39289】Re:改ページする行の取得方法　追伸 akko 06/6/21(水) 14:25


	【38650】改ページする行の取得方法

akko - 06/6/7(水) 19:22 -


	引用なし

	パスワード

ページ設定を　横○×縦△ページに印刷
で設定した場合に
ActiveSheet.HPageBreaks　が使えません

何か方法は無いでしょうか？お願いします。


	【38656】Re:改ページする行の取得方法

ichinose - 06/6/8(木) 6:55 -


	引用なし

	パスワード

▼akko さん：
おはようございます。

>ページ設定を　横○×縦△ページに印刷
>で設定した場合に

ということは、改ページの種類を
自動改ページに設定したということですか？

>ActiveSheet.HPageBreaks　が使えません

自動改ページ設定は、手動改ページ設定と同様の扱いが出来ない場合もありますが、
HPageBreaksコレクションとしては、取得出来ます。

WinとExcelのバージョン情報と

具体的に何ができないのかコードを掲載して説明されたほうがよいですよ！！


	【38667】Re:改ページする行の取得方法

akko - 06/6/8(木) 10:18 -


	引用なし

	パスワード

▼ichinose さん：助言有難うございます。

win200でExcel2000です。

改ページの種類を自動にしており、
下記マクロを組みましたが動きません。

Sub test()

　　Dim myRng　 As Range　　　　　'
　　Dim myPb　　As HPageBreak　　 '
　　Dim myPbRng As Range　　　　　'

　　For Each myPb In ActiveSheet.HPageBreaks
　　　　Set myPbRng = Nothing
　　　　On Error Resume Next
　　　　Set myPbRng = Intersect(myRng, _
　　　　myPb.Location.EntireRow.Offset(-1))
　　　　On Error GoTo 0
'

　　　　'-----------------------------------------------------
　　　　'　合計行の下線の変更　と　改ページ後１行目名の表示
　　　　'-----------------------------------------------------
'
　　　　If Not myPbRng Is Nothing Then
　　　　　　With myPbRng.Borders(xlEdgeBottom)
　　　　　　　　.LineStyle = xlContinuous
　　　　　　　　.Weight = xlThin
　　　　　　End With
　　　　　　With myPbRng.Cells.Offset(1)
　　　　　　　　.Font.ColorIndex = 1
　　　　　　End With
　　　　End If
　　Next

　　Cells(1, 1).Select
End Sub

横が一枚に収まらない為、集計を取った後に
ページ設定にて縦(１)×横(ブランク)にしております。
さらに合計行で改ページもしております。
同じ文言が続く為、先頭行以外は表示しておりません。(フォントカラー白)
ただ、ページが変わる場合のみ１行目を表示したく思います。

当方VBAにあまり詳しくありません。
至らぬ点があるかと思いますが宜しくお願いします。


	【38707】Re:改ページする行の取得方法

ichinose - 06/6/8(木) 20:00 -


	引用なし

	パスワード

▼akko さん：

こんばんは。

よくわかりませんが、

>ページ設定にて縦(１)×横(ブランク)にしております。
これを実行すると、水平方向の改ページは0になってしまいます。
この操作のの前は下のコードは正常に作動していたとすると、

手順としては、
１.　「ファイル」---「ページ設定」にてページ設定ダイアログを表示させます。
　　「ページ」タブの「拡大縮小印刷」にて、
　　「次のページ数に合わせて印刷」を選択し、横(ブランク)ｘ縦1設定し、一度
　　「ＯＫ」をクリックし、ダイアログを閉じます。

２.「ファイル」---「ページ設定」にてページ設定ダイアログを再度表示させます。
　「ページ」タブの「拡大縮小印刷」にて、「拡大縮小」を選択してください。
　　パーセンテージは変更せずに、「ＯＫ」をクリックし、ダイアログを閉じます。

３．合計行での改ページ設定を行ってください。
　（尚、すでに設定してあれば２．の設定で改ページの設定が確認できます）

これで、コードを実行してみてください。

>改ページの種類を自動にしており、
>下記マクロを組みましたが動きません。
>
>Sub test()
>
>　　Dim myRng　 As Range　　　　　'
>　　Dim myPb　　As HPageBreak　　 '
>　　Dim myPbRng As Range　　　　　'
>
>
>　　For Each myPb In ActiveSheet.HPageBreaks
>　　　　Set myPbRng = Nothing
>　　　　On Error Resume Next
>　　　　Set myPbRng = Intersect(myRng, _
>　　　　myPb.Location.EntireRow.Offset(-1))
>　　　　On Error GoTo 0
>'
>
>　　　　'-----------------------------------------------------
>　　　　'　合計行の下線の変更　と　改ページ後１行目名の表示
>　　　　'-----------------------------------------------------
>'
>　　　　If Not myPbRng Is Nothing Then
>　　　　　　With myPbRng.Borders(xlEdgeBottom)
>　　　　　　　　.LineStyle = xlContinuous
>　　　　　　　　.Weight = xlThin
>　　　　　　End With
>　　　　　　With myPbRng.Cells.Offset(1)
>　　　　　　　　.Font.ColorIndex = 1
>　　　　　　End With
>　　　　End If
>　　Next
>
>　　Cells(1, 1).Select
>End Sub


	【38718】Re:改ページする行の取得方法

Ned - 06/6/8(木) 22:53 -


	引用なし

	パスワード

▼akko さん：
こんにちは。
>横が一枚に収まらない為、集計を取った後に
>ページ設定にて縦(１)×横(ブランク)にしております。
>さらに合計行で改ページもしております。
ここが今ひとつ意味がわからないのでハズしてるかもしれませんが、
もし、横(１)×縦(ブランク)の間違いだとしたら、
[改ページプレビュー]をする事でHPageBreaksを取る事ができます。

ActiveWindow.View = xlPageBreakPreview
>For Each myPb In ActiveSheet.HPageBreaks
>:
>Next
ActiveWindow.View = xlNormalView


	【38731】Re:改ページする行の取得方法

akko - 06/6/9(金) 9:42 -


	引用なし

	パスワード

ichinose様、ned様
有難うございます。

もし、横(１)×縦(ブランク)の間違いでした。
ned様の
ActiveWindow.View = xlPageBreakPreview
を追加してみましたが、やはり

For Each myPb In ActiveSheet.HPageBreaks
でエラーが起こります。

何が問題なのか全くわからなくなりました。
もしくは改ページ１行目のフォントを黒にする
別の方法があれば教えて頂きたく思います。
なお、７行目まで印刷タイトルとして設定しております。

宜しくお願いします。


	【38739】Re:改ページする行の取得方法

ichinose - 06/6/9(金) 11:02 -


	引用なし

	パスワード

おはようございます。

>
>もし、横(１)×縦(ブランク)の間違いでした。
>ned様の
>ActiveWindow.View = xlPageBreakPreview
>を追加してみましたが、やはり

アクティブセルの位置と何か因果関係があるのかなあ・・・。

range("a65535").select
Doevents
range("a1").select
>For Each myPb In ActiveSheet.HPageBreaks
で試してみて下さい。

もう少しチェックしてみますが、取りあえず、これで確認してみて下さい。


	【38746】Re:改ページする行の取得方法

akko - 06/6/9(金) 11:36 -


	引用なし

	パスワード

▼ichinose さん
これの前にコメントを見てまして、
>　　For idx = 1 To ActiveSheet.HPageBreaks.Count
　　　　Set hh = ActiveSheet.HPageBreaks(idx)
を入れてみましたが、
Set hh = ActiveSheet.HPageBreaks(idx)
でインデックスが有効範囲でありませんと出ます

hhに定義付けが要りますか？

また、
range("a65535").select
Doevents
range("a1").select
For Each myPb In ActiveSheet.HPageBreaks
にしますと
For Each myPb In ActiveSheet.HPageBreaks
で同じようにエラーが出ます

何度も申し訳ありませんが宜しくお願いします


	【38749】Re:改ページする行の取得方法

ichinose - 06/6/9(金) 11:56 -


	引用なし

	パスワード

そうですねえ、駄目な場合もありますねえ！！

では、再度・・・。

標準モジュールに
'========================================
Dim rng As Range
'=========================================
Sub test()

　　Dim myRng　 As Range　　　　　'
　　Dim myPb　　As HPageBreak　　 '
　　Dim myPbRng As Range　　　　　'

　　For Each myPb In ActiveSheet.HPageBreaks
　　　　Set myPbRng = Nothing
　　　　On Error Resume Next
　　　　Set myPbRng = Intersect(myRng, _
　　　　myPb.Location.EntireRow.Offset(-1))
　　　　On Error GoTo 0
'

　　　　'-----------------------------------------------------
　　　　'　合計行の下線の変更　と　改ページ後１行目名の表示
　　　　'-----------------------------------------------------
'
　　　　If Not myPbRng Is Nothing Then
　　　　　　With myPbRng.Borders(xlEdgeBottom)
　　　　　　　　.LineStyle = xlContinuous
　　　　　　　　.Weight = xlThin
　　　　　　End With
　　　　　　With myPbRng.Cells.Offset(1)
　　　　　　　　.Font.ColorIndex = 1
　　　　　　End With
　　　　End If
　　Next

　　Rng.Select '←セルの位置を戻す
End Sub

'================================================================
Sub main()
　　Set rng = ActiveCell
　　With ActiveSheet
　　　.Cells(.Rows.Count, .Columns.Count).Select
　　　End With
　　Application.OnTime Now(), "test"
End Sub

として、mainを実行してみてください。

これで私の方では、エラーが回避できましたが・・。
試してみてください。


	【38751】Re:改ページする行の取得方法ほかには

ichinose - 06/6/9(金) 12:25 -


	引用なし

	パスワード

▼ichinose さん：
>そうですねえ、駄目な場合もありますねえ！！
>
>では、再度・・・。
>
>標準モジュールに
>'=========================================
>Sub test()
　　 dim rng as range　　
>　　Dim myRng　 As Range　　　　　'
>　　Dim myPb　　As HPageBreak　　 '
>　　Dim myPbRng As Range　　　　　'

>　　Set rng = ActiveCell
>　　With ActiveSheet
>　　　.Cells(.Rows.Count, .Columns.Count).Select
>　　　End With
　　 Doevents

>　　For Each myPb In ActiveSheet.HPageBreaks
>　　　　Set myPbRng = Nothing
>　　　　On Error Resume Next
>　　　　Set myPbRng = Intersect(myRng, _
>　　　　myPb.Location.EntireRow.Offset(-1))
>　　　　On Error GoTo 0
>'
>
>　　　　'-----------------------------------------------------
>　　　　'　合計行の下線の変更　と　改ページ後１行目名の表示
>　　　　'-----------------------------------------------------
>'
>　　　　If Not myPbRng Is Nothing Then
>　　　　　　With myPbRng.Borders(xlEdgeBottom)
>　　　　　　　　.LineStyle = xlContinuous
>　　　　　　　　.Weight = xlThin
>　　　　　　End With
>　　　　　　With myPbRng.Cells.Offset(1)
>　　　　　　　　.Font.ColorIndex = 1
>　　　　　　End With
>　　　　End If
>　　Next
>
>　　Rng.Select '←セルの位置を戻す
>End Sub

これも試してみてください。
尚、これにApplication.ScreenUpdating = False
を入れると駄目でした（インデックスが有効範囲にありませんが出ます）。


	【38753】Re:改ページする行の取得方法

akko - 06/6/9(金) 13:44 -


	引用なし

	パスワード

▼ichinose さん：
色々回答頂き大変嬉しく思います。
が、どの方法も
　 For Each myPb In ActiveSheet.HPageBreaks
でインデックスが有効範囲でありません　とエラーが出ます。

頂いたモジュールをそのままコピーしたのですが動きません。
ichinose様は動いたとの事ですよね？

どうしたものでしょうか…
お手上げ感いっぱいになりました。。。


	【38754】Re:改ページする行の取得方法

akko - 06/6/9(金) 14:01 -


	引用なし

	パスワード

とりあえず、
>　 For Each myPb In ActiveSheet.HPageBreaks
でインデックスが有効範囲でありません　とエラーが出る理由は
ページ設定で横１×縦○を選んでいるからだと判明しました

それを拡大・縮小にすればマクロ自体は動いたように見えました。
が、実際処理はされていませんでした。
エラーも出ず終わるのですが、
罫線の実線も改ページ後の１行目のフォント黒も
どちらもできてませんでした。

何が考えられるのでしょうか…

毎度毎度質問ばかりですみませんが宜しくお願いします。


	【38756】Re:改ページする行の取得方法

ichinose - 06/6/9(金) 14:58 -


	引用なし

	パスワード

▼akko さん：

>>　 For Each myPb In ActiveSheet.HPageBreaks
>でインデックスが有効範囲でありません　とエラーが出る理由は
>ページ設定で横１×縦○を選んでいるからだと判明しました
>
>それを拡大・縮小にすればマクロ自体は動いたように見えました。
>が、実際処理はされていませんでした。
>エラーも出ず終わるのですが、
>罫線の実線も改ページ後の１行目のフォント黒も
>どちらもできてませんでした。

>
>何が考えられるのでしょうか…

私は、Hpagebreakが取得できるか否かに重点を置いていたので
実際には、akko さんの提示されたコードでテストしているわけではありませんが、

↓これは、Hpagebreakが取得できたとしても正常に作動しませんよ！！

Sub test()

　　Dim myRng　 As Range　　　　　'
　　Dim myPb　　As HPageBreak　　 '
　　Dim myPbRng As Range　　　　　'

　　For Each myPb In ActiveSheet.HPageBreaks
　　　　Set myPbRng = Nothing
　　　　On Error Resume Next
　　　　Set myPbRng = Intersect(myRng, _
　　　　myPb.Location.EntireRow.Offset(-1))
'　　　　↑これmyRngには、何も設定されていないですから・・。
　　　　On Error GoTo 0
'

　　　　'-----------------------------------------------------
　　　　'　合計行の下線の変更　と　改ページ後１行目名の表示
　　　　'-----------------------------------------------------
'
　　　　If Not myPbRng Is Nothing Then
　　　　　　With myPbRng.Borders(xlEdgeBottom)
　　　　　　　　.LineStyle = xlContinuous
　　　　　　　　.Weight = xlThin
　　　　　　End With
　　　　　　With myPbRng.Cells.Offset(1)
　　　　　　　　.Font.ColorIndex = 1
　　　　　　End With
　　　　End If
　　Next

私は、これ省略しているだけでどこかで設定しているのだろうと解釈していました。

>ページ設定で横１×縦○を選んでいるからだと判明しました
だとすると、同じエラーでも私とakko さんとでは、見ているシートが違うのだと
思います。

私とakko さんとで見ているシートの同期をとらなければなりませんね！！

出かけるので後になりますが、同じシートを見られるように同期をとる
ことを試みようと思います。

まずは、上記のエラー箇所を確認してみて下さい。


	【38759】Re:改ページする行の取得方法

ハチ - 06/6/9(金) 15:58 -


	引用なし

	パスワード

横から失礼します。

Excel2000を使っているのですが、
自動改ページだと改ページプレビューだけでは、
Countは正常にされているのですが、
HPageBreaks(i)の値が上手く入ってきませんでした。
一度、改ページプレビュー状態で最後まで読み込ませると
うまくいくようになりました。
トンチンカンな内容ならスイマセン。

Sub Hp_test()

Dim i As Integer
Dim myR As Long

Application.ScreenUpdating = False

With ActiveSheet
　　ActiveWindow.View = xlPageBreakPreview
　　ActiveCell.SpecialCells(xlLastCell).Select
　　　　
　　　　For i = 1 To .HPageBreaks.Count
　　　　　　myR = .HPageBreaks(i).Location.Row
　　　　　　.Rows(myR).Font.ColorIndex = 1
　　　　Next i
　　
　　ActiveWindow.View = xlNormalView
　　.Cells(1, 1).Select
End With

Application.ScreenUpdating = True

End Sub


	【38760】Re:改ページする行の取得方法

akko - 06/6/9(金) 16:20 -


	引用なし

	パスワード

▼ichinose さん：
有難うございます。設定したところ作動しました！

ほぼ希望のものにはなりましたが、
２点ほど直したいのがあります。
私が間違えていたのですが、
このマクロではページの終わりは全て実線になります。
私としてはB列が○○計となっている時にのみ
データが入っている列までの下線を実線にしたいです。
B列とわかっているのであれば
オートフィルタを使う方が早いでしょうか？

あと、ページ設定が問題となっていたので
ハチさんの言われるように改ページプレビュー状態で処理しようと思い、
ActiveWindow.View = xlPageBreakPreview
を使って実行させたのですがやはりエラーとなります
横１×縦(ブランク)の設定で表示された％を変えずに
拡大/縮小の設定にする事は可能なのでしょうか？


	【38765】Re:改ページする行の取得方法

ハチ - 06/6/9(金) 17:01 -


	引用なし

	パスワード

▼akko さん：

私の環境では、改ページプレビュー状態で
↓をやることで動作するようになったのですが。
ActiveCell.SpecialCells(xlLastCell).Select

ichinose さんの方法で正解に近づいたのであれば、
私の案は忘れてください＾＾


	【38770】Re:改ページする行の取得方法

ichinose - 06/6/9(金) 18:19 -


	引用なし

	パスワード

▼akko さん：
PageBreakオブジェクトにはいくつか不具合がありそうですねえ！！
（そう言えば、印刷ページ総数の算出もPagebreakオブジェクトからアプローチすると
正しい値が算出できなかったと思いました）。

Excel4Macroをさぐってみました。
（Helpを探すのに時間がかかりました、忘れちゃって・・、ファイル名を）
'====================================
Sub test()
　Dim hhpgnum As Long
　Dim hhbk As Long
　With ActiveSheet
　　　.PageSetup.PrintArea = .UsedRange.Address
　　　End With
　hhpgnum = ExecuteExcel4Macro("COLUMNS(GET.DOCUMENT(64))")
　For idx = 1 To hhpgnum
　　hhbk = ExecuteExcel4Macro("INDEX(GET.DOCUMENT(64),1," & idx & ")")
　　MsgBox hhbk & "==== " & IIf(Rows(hhbk).PageBreak = xlPageBreakAutomatic, "自動", "手動")
　　Next
End Sub

問題のシートをアクティブにして、試してみて下さい。
正常に作動すれば、改ページ行と改ページの種類が表示されます。
今まで大きく違う点は、Excel4Macroを使用した点と
印刷範囲を指定した点です。

こちらでは、私が提示した今までコードでも正常に作動しているので
うまくいくかわかりませんが、ページ設定で横１×縦○を選んで確認して下さい。


	【38849】Re:改ページする行の取得方法

akko - 06/6/12(月) 18:22 -


	引用なし

	パスワード

▼ichinose さん：
お返事が遅くなりすみません。

上記マクロで動きましたが、
手動の行数は一致しますが、自動の行数が一致しません。
自動は最初の１回だけ表示されてその後出てきません。
データは2395行目までありますが、メッセージボックスに
”2396===手動”と出た後
　　hhbk = ExecuteExcel4Macro("INDEX(GET.DOCUMENT(64),1," & idx & ")")
でエラーが出ます。範囲指定が必要ですか？

また、メッセージボックスが出るたびに列幅が広がっていきます。

何か解決策はありませんか？

宜しくお願いします。


	【38851】Re:改ページする行の取得方法

ichinose - 06/6/12(月) 19:04 -


	引用なし

	パスワード

▼akko さん：
こんばんは。
駄目ですか？
>上記マクロで動きましたが、
>手動の行数は一致しますが、自動の行数が一致しません。
>自動は最初の１回だけ表示されてその後出てきません。
>データは2395行目までありますが、メッセージボックスに
>”2396===手動”と出た後
>　　hhbk = ExecuteExcel4Macro("INDEX(GET.DOCUMENT(64),1," & idx & ")")
>でエラーが出ます。範囲指定が必要ですか？
>
>また、メッセージボックスが出るたびに列幅が広がっていきます。
>何か解決策はありませんか？

http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=38770;id=excel

今度は、akko さんが今、抱えている問題のシートではなく、
新規に作成したブックで上記のコードを試してみてください。
で、それでも同じエラーが出る場合は、そのエラーが出るシートを作成する
手順書を記述してください。

そうしないと今現在の状況では、同じシート（ブック）を
私とakko さんが見ていないことになっています。
（よって、私にはエラーが再現できない）

難しいことですが、これが出来れば、多くの方から解決策の投稿が
あるかもしれませんよ！！


	【38878】Re:改ページする行の取得方法

akko - 06/6/13(火) 14:56 -


	引用なし

	パスワード

集計かけて、オートフィルタをつけて、
列を一部隠して集計表を作ってます。

ichinoseさんの言われるように新規のブックで
値だけ貼り付けたり集計を解除したり列を全て表示したりして
試してみたところマクロ自体は動きました。
が、列幅を初期設定から自動調整もしくは任意の幅に設定した場合に
横に広がる現象が出ました。(列幅：78.88)

列幅が全て同じ幅の時はこの現象は起こらず、
列によって幅が異なる場合は起きる事がわかりました。

何か解決方法は無いでしょうか？
宜しくお願いします。


	【38897】Re:改ページする行の取得方法

ichinose - 06/6/13(火) 22:53 -


	引用なし

	パスワード

▼akko さん：
こんばんは。

>集計かけて、オートフィルタをつけて、
>列を一部隠して集計表を作ってます。
これは、はじめて聞きました。
>
>ichinoseさんの言われるように新規のブックで
>値だけ貼り付けたり集計を解除したり列を全て表示したりして
>試してみたところマクロ自体は動きました。
>が、列幅を初期設定から自動調整もしくは任意の幅に設定した場合に
>横に広がる現象が出ました。(列幅：78.88)
>
>列幅が全て同じ幅の時はこの現象は起こらず、
>列によって幅が異なる場合は起きる事がわかりました。
この記述で私が想像するシートとは、

新規ブックの標準モジュールに
'============================================================
Sub Mk_sample_data()
　　Dim rng As Range
　　With ActiveSheet
　　　 With .Range("a1:e1")
　　　　　.Value = Array("項目1", "項目2", "項目3", "項目4", "項目5")
　　　　　For Each rng In .Cells
　　　　　　 With rng.EntireColumn
　　　　　　　　.ColumnWidth = .ColumnWidth + 3 * .Column
　　　　　　　　End With
　　　　　　 Next
　　　　　End With
　　　 With .Range("a2:e2500")
　　　　　.Formula = "=int(rand()*10000)+1"
　　　　　.Value = .Value
　　　　　　　　　
　　　　　End With
　　　 With .PageSetup
　　　　　.Zoom = False
　　　　　.FitToPagesWide = 1
　　　　　.FitToPagesTall = False
　　　　　End With
　　　 End With
End Sub
'===========================================================
Sub test()
　Dim hhpgnum As Long
　Dim hhbk As Variant
　Dim idx As Long
　With ActiveSheet
　　　.PageSetup.PrintArea = .UsedRange.Address
　　　End With
　hhpgnum = ExecuteExcel4Macro("COLUMNS(GET.DOCUMENT(64))")
　For idx = 1 To hhpgnum
　　hhbk = ExecuteExcel4Macro("INDEX(GET.DOCUMENT(64),1," & idx & ")")
　　MsgBox hhbk & "==== " & IIf(Rows(hhbk).PageBreak = xlPageBreakAutomatic, "自動", "手動")
　　Next
End Sub

上記の Mk_sample_dataを実行してみて下さい。
Ａ列～Ｅ列の２５００行までにデータが設定されます（１行目は、見出し）
Ａ～Ｅ列の列幅を変えています。

とこんなシートをイメージします。

こんなシートに対して、testを実行しても列幅は変更しません。

ということは、akko さんが想定しているシートとは違うということですね？

列幅が変わると言う現象が再現できる手順書を気述してください。
（これは、誰が作成しても現象が再現できるシートの作成手順です）。

１．Excelを起動します。

から、始まった事細かな記述が必要なんです。

もしくは、問題シートを作成するコードの提示などです。


	【38931】Re:改ページする行の取得方法

akko - 06/6/14(水) 18:03 -


	引用なし

	パスワード

▼ichinose さん：
こんばんは

ichinoseさんが書いて頂いたMk_sample_dataに追加して作りました
下記で私の方は現象が再現されております
列が１ページで収まらない場合に起こる感じです

宜しくお願いします

Sub Mk_sample_data()
　　Dim rng As Range
　　With ActiveSheet
　　　 With .Range("a1:R1")
　　　　　.Value = Array("項目1", "項目2", "項目3", "項目4", "項目5", "項目6", "項目7", _
　　　　　"項目8", "項目9", "項目10", "項目11", "項目12", "項目13", "項目14", "項目15" _
　　　　　, "項目16", "項目17", "項目18")
　　　　　For Each rng In .Cells
　　　　　　 With rng.EntireColumn
　　　　　　　　.ColumnWidth = .ColumnWidth + 3 * .Column
　　　　　　　　End With
　　　　　　 Next
　　　　　End With
　　　 With .Range("a2:R2500")
　　　　　.Formula = "=int(rand()*10000)+1"
　　　　　.Value = .Value
　　　　　
　　　　　End With
　　　 With .PageSetup
　　　　　.Zoom = False
　　　　　.FitToPagesWide = 1
　　　　　.FitToPagesTall = False
　　　　　End With
　　　 End With
　　Cells.Select
　　Cells.EntireColumn.AutoFit
　　Range("A1").Select
End Sub
'===========================================================
Sub test()
　Dim hhpgnum As Long
　Dim hhbk As Variant
　Dim idx As Long
　With ActiveSheet
　　　.PageSetup.PrintArea = .UsedRange.Address
　　　End With
　hhpgnum = ExecuteExcel4Macro("COLUMNS(GET.DOCUMENT(64))")
　For idx = 1 To hhpgnum
　　hhbk = ExecuteExcel4Macro("INDEX(GET.DOCUMENT(64),1," & idx & ")")
　　MsgBox hhbk & "==== " & IIf(Rows(hhbk).PageBreak = xlPageBreakAutomatic, "自動", "手動")
　　Next
End Sub


	【38937】Re:改ページする行の取得方法

ichinose - 06/6/14(水) 21:33 -


	引用なし

	パスワード

▼akko さん：

こんばんは
>
>ichinoseさんが書いて頂いたMk_sample_dataに追加して作りました
>下記で私の方は現象が再現されております
>列が１ページで収まらない場合に起こる感じです

Excel2000　SR-1　SP-3　Excel2002　SP-3で
試しましたが再現しません。
つまり、列幅が変更されると言う現象は起きません。

>
>宜しくお願いします
>
>Sub Mk_sample_data()
>　　Dim rng As Range
>　　With ActiveSheet
>　　　 With .Range("a1:R1")
>　　　　　.Value = Array("項目1", "項目2", "項目3", "項目4", "項目5", "項目6", "項目7", _
>　　　　　"項目8", "項目9", "項目10", "項目11", "項目12", "項目13", "項目14", "項目15" _
>　　　　　, "項目16", "項目17", "項目18")
>　　　　　For Each rng In .Cells
>　　　　　　 With rng.EntireColumn
>　　　　　　　　.ColumnWidth = .ColumnWidth + 3 * .Column
>　　　　　　　　End With
>　　　　　　 Next
>　　　　　End With
>　　　 With .Range("a2:R2500")
>　　　　　.Formula = "=int(rand()*10000)+1"
>　　　　　.Value = .Value
>　　　　　
>　　　　　End With
>　　　 With .PageSetup
>　　　　　.Zoom = False
>　　　　　.FitToPagesWide = 1
>　　　　　.FitToPagesTall = False
>　　　　　End With
>　　　 End With
>　　Cells.Select
>　　Cells.EntireColumn.AutoFit
>　　Range("A1").Select
>End Sub
>'===========================================================
>Sub test()
>　Dim hhpgnum As Long
>　Dim hhbk As Variant
>　Dim idx As Long
>　With ActiveSheet
>　　　.PageSetup.PrintArea = .UsedRange.Address
>　　　End With
>　hhpgnum = ExecuteExcel4Macro("COLUMNS(GET.DOCUMENT(64))")
>　For idx = 1 To hhpgnum
>　　hhbk = ExecuteExcel4Macro("INDEX(GET.DOCUMENT(64),1," & idx & ")")
　　 debug.print hhbk & "==== " & IIf(Rows(hhbk).PageBreak = xlPageBreakAutomatic, "自動", "手動")
>　　Next
>End Sub

ちなみにMsgboxではなく、イミディエイトウインドウに結果を表示した場合も
列幅は変更されてしまいますか？


	【38938】Re:改ページする行の取得方法　追伸

ichinose - 06/6/14(水) 21:40 -


	引用なし

	パスワード

このコードで作成されたシートに対して
以前提示したコード
Dim rng As Range
'=========================================
Sub test()
　　Dim myPb　　As HPageBreak　　 '
　　For Each myPb In ActiveSheet.HPageBreaks
　　　　Debug.Print myPb.Location.EntireRow.Address
　　Next

　　rng.Select '←セルの位置を戻す
End Sub

'================================================================
Sub main()
　　Set rng = ActiveCell
　　With ActiveSheet
　　　.Cells(.Rows.Count, .Columns.Count).Select
　　　End With
　　Application.OnTime Now(), "test"
End Sub

や、
ハチさんの
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=38759;id=excel

これらも試してみて下さい。


	【38951】Re:改ページする行の取得方法　追伸

ハチ - 06/6/15(木) 9:18 -


	引用なし

	パスワード

ichinose さんのMk_sample_dataを拝借してテストしてみました。
列数をもう少し大きくとってBB列までのsampleに。
Win2000/SP3 Excel2000 の環境ではうまく動作しました。

マクロ中にもコメントしてますが、
改ページプレビュー状態で
改ページ設定＞改ページ削除＞改ページ再設定　と実施すると動作しました。
なぜなのか不明です・・・

Option Explicit

Sub Mk_sample_data()
　　Dim rng As Range
　　With ActiveSheet
　　　 With .Range("a1:R1")
　　　　　.Value = Array("項目1", "項目2", "項目3", "項目4", "項目5", "項目6", "項目7", _
　　　　　"項目8", "項目9", "項目10", "項目11", "項目12", "項目13", "項目14", "項目15" _
　　　　　, "項目16", "項目17", "項目18")
　　　　　For Each rng In .Cells
　　　　　　 With rng.EntireColumn
　　　　　　　　.ColumnWidth = .ColumnWidth + 3 * .Column
　　　　　　　　End With
　　　　　　 Next
　　　　　End With
　　　 With .Range("a2:BB2500") 'BB列までに変更
　　　　　.Formula = "=int(rand()*10000)+1"
　　　　　.Value = .Value
　　
　　　　　End With
　　　 'With .PageSetup 'PageSetupは、HB_testで実行
　　　　　'.Zoom = False
　　　　　'.FitToPagesWide = 1
　　　　　'.FitToPagesTall = False
　　　　'End With
　　　　　.Cells.Font.ColorIndex = 2 '文字色白に変更
　　　　　.Columns("A").Font.ColorIndex = 1 '一列目を黒見やすいように
　　　　　.Columns("BB").Font.ColorIndex = 1　'最終列を黒　見やすいように
　　　　　
　　　 End With
　　Cells.Select
　　Cells.EntireColumn.AutoFit
　　Range("A1").Select
End Sub

Sub HB_test()

Dim i As Integer
Dim myR As Long

Application.ScreenUpdating = False
ActiveWindow.View = xlPageBreakPreview

With ActiveSheet
　　.PageSetup.Zoom = False
　　.PageSetup.FitToPagesWide = 1
　　.PageSetup.FitToPagesTall = False
　　'一度リセットすると上手くいく。なぜ？？
　　'リセットしないとVは合うが、Hがずれることがある
　　'（原因が・・わかりません＞＜）
　　.ResetAllPageBreaks
　　.PageSetup.FitToPagesWide = 1
　　.PageSetup.FitToPagesTall = False

　　For i = 1 To .HPageBreaks.Count
　　　　myR = .HPageBreaks(i).Location.Row
　　　　.Rows(myR).Font.ColorIndex = 1
　　Next i
　　
End With

ActiveWindow.View = xlNormalView
Application.ScreenUpdating = True

End Sub


	【39289】Re:改ページする行の取得方法　追伸

akko - 06/6/21(水) 14:25 -


	引用なし

	パスワード

▼ハチさん：
　ichinoseさん：

お返事大変遅くなり申し訳ありませんでした。

記述し忘れてましたが、win2000/SR1/SP4,excel2000です
自宅に持ち帰ったところうまく作動しました(XP)
会社のXPパソコンで使用したところうまく作動しました
2000が問題なのかと思いましたが、ハチさんが2000なのですよね…
ポリシーって関係するものでしょうか？


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

7417 / 13644 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free