• ベストアンサー
※ ChatGPTを利用し、要約された質問です(原文:PageBreak プロパティを設定できません。)

ExcelマクロでPageBreakプロパティを設定できないエラーの解決方法とは?

このQ&Aのポイント
  • ExcelマクロにおいてPageBreakプロパティを設定する際に発生するエラーの解決方法について紹介します。
  • 具体的には、セルの削除やビューの切り替え、特定のバージョンでの挙動などが関わっています。
  • また、デバッグウィンドウを表示しF5で実行するとエラーが発生しないという現象も確認されています。

質問者が選んだベストアンサー

  • ベストアンサー
  • end-u
  • ベストアンサー率79% (496/625)
回答No.1

2003でも発生しますね。 [改ページプレビュー]時の描画関係で何か不具合があるのかもしれません。 #タイミングの問題? 解消策としては ・一旦[標準]ビューで処理し、最後に[改ページプレビュー]設定する。 ・ws_sheet2をActiveにして実行する。 ・'* 改ページの挿入の直前に DoEvents を挿入する。 ・Application.ScreenUpdating = False で実行する。 いずれでも解消するようです。 以下余談、ちょっと気になったこと。 >ws_sheet3.Range("1:10").Copy >ws_sheet2.Range("1:10").PasteSpecial Paste:=xlPasteAll xlPasteAllなら ws_sheet3.Range("1:10").Copy ws_sheet2.Range("1:10") でもいいかな、という点と >'* sheet2 をクリア なら ws_sheet2.Cells(1, 1).Resize(9, 4).ClearContents のほうがいいかな、という点です。参考まで。

y_s_x
質問者

お礼

早速の回答と、丁寧な説明、自環境で再現テストまでしていただき、 本当にありがとうございました。 >>・一旦[標準]ビューで処理し、最後に[改ページプレビュー]設定する。 (;^_^A アセアセ・・・、ご指摘を受ける前にこの方法に気付くべきですよね... この事象は質問を書いている途中で気が付き、 そこまで頭がまわりませんでした。 →解消いたしました >>・ws_sheet2をActiveにして実行する。 ws_sheet2.Activateを挿入しOKでした。 →解消いたしました ただ、オリジナルのソースの方でも既にActivateは試していたのですが 、そちらは何故かNG、もっと複雑なソースなので別要因かもしれません。 >>・'* 改ページの挿入の直前に DoEvents を挿入する。 →解消いたしました >>・Application.ScreenUpdating = False で実行する。 こちらの環境ではNGでした。 Application.ScreenUpdating = False '* 改ページの挿入 ws_sheet2.Cells(idx_sentou + 1, 1).PageBreak = xlManual Application.ScreenUpdating = True >>ws_sheet3.Range("1:10").Copy ws_sheet2.Range("1:10") >>でもいいかな、という点と VB ならまだしも VBA となるとまるで素人で、よくわからず 作っております、ご指摘の通りに修正しました。 >>ws_sheet2.Cells(1, 1).Resize(9, 4).ClearContents >>のほうがいいかな、という点です。参考まで。 同じく、ご指摘の通りに修正しました。 こう言うアドバイスって素人には本当に助かります。 最終的には DoEvents 使用し解決とさせていただきました。 なにはともあれ、本当にありがとうございました。

全文を見る
すると、全ての回答が全文表示されます。

関連するQ&A

  • エクセル マクロの設定方法について

    差込印刷でSheet1に作成した名簿データにより、sheet2に作成しているデータへ差込印刷をしています。現在、次のようなマクロを組んで名簿の件数に合わせて、For = 2 To 500 Step 8を修正しながら、印刷しています。できたら、名簿の件数の増減に関係なく印刷できるようになればと考えています。始めたばかりのマクロ初心者です。よろしくご教授ください。お願いします。 Dim i As Long Dim ws1 As Worksheet, ws2 As Worksheet Set ws1 = sheets(″sheet1″) Set ws2 = sheets(″sheet2″) For i = 2 To 500 Step 8 ws2 .Range(″A1″).Value = ws1.Cells(i+1,2).Value ws2 .Range(″A7″).Value = ws1.Cells(i+2,2).Value ws2 .Range(″A13″).Value = ws1.Cells(i+3,2).Value ws2 .Range(″A19″).Value = ws1.Cells(i+4,2).Value ws2 .Range(″F1″).Value = ws1.Cells(i+5,2).Value ws2 .Range(″F7″).Value = ws1.Cells(i+6,2).Value ws2 .Range(″F13″).Value = ws1.Cells(i+7,2).Value ws2 .Range(″F19″).Value = ws1.Cells(i+8,2).Value DoEvents ws2.PrintOut Next End Subws2 .Range(″F1″).Value = ws1.Cells(i+5,2).Value ネット等で調べて、上記のようなマクロで作業してます。(マクロの設定方法が間違っているところがあると思いますが?)

  • エクセルマクロで教えてください

    Sub smp05_14_01() Dim 対象セル As Range Dim ws1 As Worksheet Dim ws2 As Worksheet Dim ws3 As Worksheet Dim 行 As Long, 列 As Long Dim i As Long Set ws1 = Worksheets("顧客") Set ws2 = Worksheets("売上") Set ws3 = Worksheets("顧客未登録") 行 = ws1.Range("A1").End(xlDown).Row - 1 列 = ws1.Range("A1").End(xlToRight).Column Set 対象セル = ws1.Cells(1, 列 + 2).Resize(2, 行) For i = 1 To 行 対象セル(1, i).Value = "顧客NO" 対象セル(2, i).Value = "<>" & ws1.Cells(i + 1, 1) Next ws2.Range("A1").CurrentRegion.AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=対象セル, _ CopyToRange:=ws3.Range("A1") 対象セル.Clear End Sub 上記のマクロは売上のシートに登録されている以外の顧客NOを顧客シートを参照して顧客未登録シートにコピーするのもですが添付したファイルの数だと上手くいくのですが、エクセルのヨコのセルの最大値の258を越えると上手くいきません。上記の処理で1000レコードを越えても売上シートに登録されている以外の顧客NOを参照して顧客未登録シートにコピーするマクロを教えてください。

  • Excel VBA 連番印刷

    昨日以下の質問をさせていただいた者です。 http://okwave.jp/qa/q8349562.html こちらで教えていただいた以下のコードに、 J2のセルに連番を振るコードを付け足したいと思い、 同じくこちらのサイトの過去の履歴にあった以下コードを参考にとやってみているのですが、 Next で指定された変数の参照が無効です。と言われてしまいます… 印刷部数の指定はいらず、sheet印刷のJ2セルに1から始まる連番を振りたいのです。 どのように修正をしたらいいのかご教示願います。 Sub Sample4() Dim i As Long, endRow1 As Long, endRow2 As Long, myArea1 As Range, myArea2 As Range Dim wS1 As Worksheet, wS2 As Worksheet, wS3 As Worksheet Set wS1 = Worksheets("DB") Set wS2 = Worksheets("印刷") Set wS3 = Worksheets("Sheet3") endRow1 = wS1.Cells(Rows.Count, "A").End(xlUp).Row Range(wS1.Cells(1, "A"), wS1.Cells(endRow1, "A")).AdvancedFilter Action:=xlFilterInPlace, unique:=True wS1.Range("A:A").Copy wS3.Range("A1") wS1.ShowAllData For i = 2 To wS3.Cells(Rows.Count, "A").End(xlUp).Row endRow2 = wS2.Cells(Rows.Count, "B").End(xlUp).Row If endRow2 > 9 Then Range(wS2.Cells(10, "B"), wS2.Cells(endRow2, "H")).ClearContents Range(wS2.Cells(10, "J"), wS2.Cells(endRow2, "J")).ClearContents End If wS1.Range("A1").AutoFilter field:=1, Criteria1:=wS3.Cells(i, "A") wS2.Range("B6") = wS3.Cells(i, "A") Set myArea1 = Range(wS1.Cells(2, "B"), wS1.Cells(endRow1, "H")).SpecialCells(xlCellTypeVisible) Set myArea2 = Range(wS1.Cells(2, "I"), wS1.Cells(endRow1, "I")).SpecialCells(xlCellTypeVisible) myArea1.Copy wS2.Activate ActiveSheet.Range("B10").Select Selection.PasteSpecial Paste:=xlPasteValues myArea2.Copy wS2.Activate ActiveSheet.Range("J10").Select Selection.PasteSpecial Paste:=xlPasteValues endRow2 = wS2.Cells(Rows.Count, "B").End(xlUp).Row 'Range(wS2.Cells(1, "A"), wS2.Cells(endRow2, "J")).PrintOut Next i wS1.AutoFilterMode = False wS3.Cells.Clear End Sub 連番印刷のコード Sub NumberPrint() Dim idx As Integer Dim res  res = Application.InputBox("印刷部数を入力してください", Type:=1)  If res > 0 Then   For idx = 1 To res    Range("AW3").Value = idx    ActiveSheet.PrintOut   Next idx  End If End Sub

  • EXCEL2010エラーVBA

    下記を実行するとエラーになりEXCEL2010が終了してしまいます。 fDebug:0 offset00009391 がエラーメッセージです。 何が原因でしょうか。 Private Sub Worksheet_Change(ByVal Target As Range) Dim ws As Worksheet Dim rg As Range Dim r As Variant Dim c As Long Dim hanni1 As Range Dim atai As Range Set ws = Worksheets("あああ") Set rg = Worksheets("コード").Range("A1:B10") r = ws.Cells(Rows.Count, 1).End(xlUp).Row Set hanni1 = ws.Range(Cells(2, 2), Cells(r, 3)) Set atai = ws.Range(Cells(2, 3), Cells(r, 3)) atai = Application.VLookup(hanni1, rg, 2, False) End Sub

  • シートのイベント VBA

    シートをクリックしたらシートをクリアしたいのですが クリックするセルがA1の場合は、マクロを実行させたくないのですが 下記のコードだとエラーになってしまいます。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Target.Range = Range("a1") Then Cells.Clear End If End Sub ”Range("a1")でなければ、Cells.Clearする” にはどうすればいいですか?

  • Excel VBA データの入っているセルの取り出し

    Excel VBA データの入っているセルの取り出し Excel2007使用です。 大きなセル範囲の中にデータが点在している場合に、そのデータを一か所にまとめるマクロを作りたいです。セル範囲は決まっています(A1:Q100)。最終的には隣のセルの1列にまとめたいです。 以下のようなマクロを作ってみましたが、いずれも作動しませんでした(エラーメッセージも出ず) NullをEmptyに変えてみても同じでした。 (ややこしいですが、アクティブセルはSheet2、Sheet1へ貼り付けたい) (とりあえずシート内で列上部にまとめようとした) Dim myRange As Range For Each myRange In Range("A1:Q100") If myRange.Value = Null Then myRange.Delete xlShiftUp End If Next myRange End Sub (1行1列ずつの参照をループさせて「空白でない」セルを切り取り-貼り付けさせようとした) Worksheets("sheet2").Activate Dim Gyou As Integer Dim Retsu As Integer For Gyou = 1 To 100 For Retsu = 1 To 17 If Cells(Gyou, Retsu).Value = Not Null Then Cells(Gyou, Retsu).Cut Destination:=Worksheets("sheet1").Cells(5, 2) End If Next Retsu Next Gyou End Sub また、以下のマクロは、実行すると現状のままSheet1のE列以降に移るだけで、データのあるセルだけがまとまるという状態にはなりません。 Range("A1:Q100").SpecialCells(xlCellTypeVisible).Cut Destination:=Worksheets("Sheet3").Range("E1") End Sub 以下は某サイトで、まさに「空白セルを削除しデータの入ってるセルを上詰めにする」というマクロが紹介されていたので、加工してやってみましたが、「RangeクラスのDeleteメソッドが失敗しました」という実行時エラーが出てできませんでした。 Dim WS As Worksheet Dim myRng As Range Dim Lrow As Long Set WS = Worksheets("Sheet1") Lrow = WS.Range("A" & CStr(Rows.Count)).End(xlUp).Row Set myRng = WS.Range("A1:A" & CStr(Lrow)) myRng.SpecialCells(xlCellTypeBlanks).Delete xlShiftUp End Sub データの入っているセルだけを取り出して一つの列にまとめたいのですが、どうしたらいいのでしょうか。

  • エクセル2007 参照セルの値が認識されない

    エクセル2007の環境で下記マクロを実行すると、 アクティブシートのセルA1に数字が入っている場合、Sheet1のセルA1に値を転記しても そのセルA1の値をVLOOKUP関数で参照できません。 マクロに問題があるためなのか何処に問題があるのか分からないので教えてください。 宜しくお願いいたします。 【sheet】は アクティブシートの3行目から1000行目までのA列のセルをクリックしたらセルA1に値を表示 その後、下記【モジュール】を使用し、 アクティブシートのセルA1が空白の場合、 A列の数値をSheet1のセルA1に転記し、アクティブシートのA列の数値が空白になるまで循環する。 Sheet1のセルA1の値をVLOOKUP関数で参照した内容を表示、印刷します。 ----------------------------------------------------------------- '【sheet】 Private Sub Worksheet_SelectionChange(ByVal Target As Range) With Target If .Count > 1 + IsEmpty(.Value) Then Exit Sub If Application.Intersect(.Cells, Range("A3:A1000")) Is Nothing Then Exit Sub ActiveSheet.Cells(1, 1).Value = .Value End With End Sub ----------------------------------------------------------------- '【モジュール】 Sub TEST() Dim myBtn As Integer Dim myMsg As String, myTitle As String Dim WS1 As Worksheet, WS2 As Worksheet Dim i As Long myMsg = "●●●" myTitle = "確 認" myBtn = MsgBox(myMsg, vbYesNo + vbExclamation, myTitle) If myBtn = vbYes Then Set WS1 = ActiveSheet Set WS2 = Sheet1 If WS1.Cells(1, 1).Value = "" Then With WS1 For i = 3 To 65536 If .Cells(i, 1).Value = "" Then Exit For WS2.Cells(1, 1).Value = .Cells(i, 1).Value WS2.Cells(1, 2).Value = ActiveSheet.Name 'WS2.PrintOut Copies:=1 Next i End With ElseIf WS1.Cells(1, 1).Value >= 1 Then WS2.Cells(1, 1).Value = WS1.Cells(1, 1).Value WS2.Cells(1, 2).Value = WS1.Name 'WS2.PrintOut Copies:=1 Else End If End If End Sub -----------------------------------------------------------------

  • エクセルのVBAの記述について

    VBAの記述についてなのですが、 Sub filter() Dim gyo As Long Dim ws1 As Worksheet Dim ws2 As Worksheet Dim ws3 As Worksheet Set ws1 = Worksheets("データ") Set ws2 = Worksheets("チーム") Application.ScreenUpdating = False ws2.Range("A4:BH30").Clear gyo = ws1.Range("A65536").End(xlUp).Row ws1.Activate With ws1.Range(Cells(4, 1), Cells(gyo, 6)) .AutoFilter Field:=1, Criteria1:="A" .SpecialCells(xlCellTypeVisible).Copy ws2.Range("A4") Selection.AutoFilter End With Application.ScreenUpdating = True End Sub ならプログラムははしるのですが、 14行目を .SpecialCells(xlCellTypeVisible).Copy ws2.Range(Cells(4, 1)) だと 「実行時エラー 1004 Rangeメソッドは失敗しました Worksheet オブジェクト」 とでるのですが、出来ないのでしょうか? Cells(4, 1)の1のところを変数にして変えていきたいのですが、よい方法はありますか。 よろしくお願いいたします。

  • 全部黄色になってしまいます

    下記のマクロを作成しました。 1.Sheet1のA列の数字を1つずつ検索して、sheet2にその数字があれば、sheet2のそのセル赤くする。 全部あればすべてのセルが赤くなり、無いところがあれば白いままというマクロ 2.sheet1羅列を検索してsheet2に無い場合、逆にsheet1のその数字(検索してなかった数字)を黄色にする。 困っていることは、何も数字の無いところが全部黄色になってしまいます。 sheet1の空白のところは処理せずにそのまま白くあって欲しいのですがどのようにすればいいでしょうか? ●sheet1のA列に下記のような数字が羅列(200行程)しています。 238062 238075 238096 238210 91518 238230 123456 789123 456789 ●sheet2のA列に下記のような数字が羅列しています。 91518 238062 238075 238096 238210 Sub 赤色付け() Set WS1 = Worksheets("Sheet1") Set WS2 = Worksheets("Sheet2") Dim RowPos As Integer Dim i As Integer For RowPos = 1 To 200 If WorksheetFunction.CountIf(Range(WS2.Cells(1, 1), WS2.Cells(200, 1)), WS1.Cells(RowPos, 1)) > 0 Then i = WorksheetFunction.Match(WS1.Cells(RowPos, 1), Range(WS2.Cells(1, 1), WS2.Cells(200, 1)), 0) WS2.Cells(i, 1).Interior.ColorIndex = 3 ELSE WS1.Cells(RowPos, 1).Interior.ColorIndex = 6 End If Next End Sub

  • Excel マクロの一部改造の方法を教えて下さい。

    先日、tom04さんから下記のマクロを教えていただきました。 sheet1のセルA1にsheet2のセルA1からA??までの項目を順次入れ、sheet1を印刷するものです。 これに、追加でsheet1のセルB1にも項目を追加したいのです、データーはsheet2のB1から入れておくこととします。 下記のマクロを教えて下さった、tom04さんの目にとまれば幸いですが、内容を理解して頂いた方ならどなたでも回答頂ければ幸いです。よろしくお願い致します。 改造して頂きたいマクロは下記です。 Sub test() 'この行から Dim i As Long Dim ws1, ws2 As Worksheet Set ws1 = Worksheets("sheet1") '←Sheet名は適宜変更してください Set ws2 = Worksheets("sheet2") '←こちらのSheet名も適宜変更 For i = 1 To ws2.Cells(Rows.Count, 1).End(xlUp).Row ws1.Range("A1") = ws2.Cells(i, 1) '←Sheet1のA1セルに名前を表示 ws1.PrintOut Next i End Sub 'この行まで