エクセルの連続印刷マクロについて

このQ&Aのポイント
  • VBAの知識がなく困っています。
  • エクセルのC1を+1、B5を+10連番で増やして印刷したいのですが、Webで調べた下記の記述に、色々プラスしてみましたが、片方の数しか増えません。
  • ご教示お願いいたします。
回答を見る
  • ベストアンサー

エクセルの連続印刷マクロについて

VBAの知識がなく困っています。 エクセルのC1を+1、B5を+10連番で増やして印刷したいのですが、Webで調べた下記の記述に、色々プラスしてみましたが、片方の数しか増えません。 ご教示お願いいたします。 Const conStart As Long = 51 '開始番号 Const conEnd As Long = 60 '終了番号 Const conStep As Long = 1 '間隔 Const conCell As String = "C1" 'セル番地 '変数 Dim i As Long With Application .ScreenUpdating = False With .ActiveSheet.Range(conCell) For i = conStart To conEnd Step conStep .Value = i ActiveSheet.PrintOut Next End With .ScreenUpdating = True End With End Sub

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

  • ベストアンサー
  • kkkkkm
  • ベストアンサー率65% (1617/2456)
回答No.1

51から+10連番でしたら以下のようにしてみてください。 略 With Application .ActiveSheet.Range("B5").Value = conStart .ScreenUpdating = False With .ActiveSheet.Range(conCell) For i = conStart To conEnd Step conStep .Value = i With Application.ActiveSheet.Range("B5") .Value = .Value + 10 End With ActiveSheet.PrintOut Next End With 略

kirkirahikaru
質問者

お礼

全く無知でしたが何とか解決できました。 ありがとうございました。

kirkirahikaru
質問者

補足

ありがとうございます。 この記述で動きましたが、すみません、情報が不足しておりました。 B5の10ずつ増やすのは、C1が51の時、B5は501から10ずつ増やしたいです。

その他の回答 (1)

  • kkkkkm
  • ベストアンサー率65% (1617/2456)
回答No.2

> B5の10ずつ増やすのは、C1が51の時、B5は501から10ずつ増やしたいです。 .ActiveSheet.Range("B5").Value = conStart これが何をしてるのか考えたら聞く必要もなく答えは分かると思いますが。

関連するQ&A

  • エクセルで型番ごとにワークシートをマクロで作る方法

    昨日に質問させて頂いたものですが、下記のマクロを教えて頂いたのですが 新しく生成された型番のワークシートが抜けていたり、最後まで型番が生成されない状態です。 なにか間違っていたら直して頂ける方お願いします。 Sub macro4()  Dim h As Range  Dim w As Worksheet  Dim i As Long, e As Long  Application.ScreenUpdating = False  Application.CutCopyMode = False ’準備  Set w = ActiveSheet  w.Range("4:4").Insert shift:=xlShiftDown  e = Range("B65536").End(xlUp).Offset(1).Row  Range("B4").Select ’複写  Do   ActiveSheet.Copy after:=ActiveSheet   Selection.EntireRow.Delete shift:=xlShiftUp  Loop Until ActiveCell.Offset(1) = "" ’片付け  For i = ActiveSheet.Index To w.Index + 1 Step -1  With Worksheets(i)  .Range(.Range("B4").Offset(1), .Cells(e, "B")).EntireRow.Delete shift:=xlShiftUp  End With  Next i  w.Rows(4).Delete  Application.ScreenUpdating = True End Sub http://okwave.jp/qa/q7081084.html

  • 再び印刷マクロを

    フィールド行はA列からT列までなのですが、途中のK列からN列までは印刷したくないために、2行のマクロ Range("K1:N1").EntireColumn.Hidden = True Range("A1:S1").PrintOut を挿入したのですが、エラーとなってしまいます。 印刷マクロは下のようになっています。 Sub 最終処理分印刷() '----- 印刷範囲 列指定 --------- Const Sh = "入力シート" '  <----- シート名指定 Const Left_Col = "A" '  <------ 印刷範囲の左端列 Const Right_Col = "S" '  <----- 印刷範囲の右端列 Const Target_Col = "T" ' <----- 印刷データ判定列(日付形式) Const Prev_Mode = 1 '  <----- 0 = 直接印刷 /  1 = プレビュー '------------------------------ Dim TopRw As Long Dim EndRw As Long Dim Target_Date As Date Dim N As Long With Worksheets(Sh)  EndRw = .Range(Target_Col & "65536").End   (xlUp).Row TopRw = EndRw Do While .Range(Target_Col & TopRw).Value = _ .Range(Target_Col & TopRw).Offset(-1).Value TopRw = TopRw - 1 If TopRw = 1 Then Exit Do Loop Range("K1:N1").EntireColumn.Hidden = True Range("A1:S1").PrintOut N = EndRw - TopRw + 1 .PageSetup.PrintArea = Range(Left_Col & TopRw & _ ":" & Right_Col & EndRw).Address If Err.Number > 0 Then Exit Sub End If If Prev_Mode = 1 Then .PrintOut preview:=True Else .PrintOut preview:=False End If .PageSetup.PrintArea = False End With End Sub

  • 【エクセル】 連続印刷する際のマクロの記述について。

    いつも大変お世話になっております。 エクセル2003のマクロの記述についてご教示のほど お願いいたします。 シート2にシート1の名簿から住所氏名等を落とし込み出来るように様式を作っています。 このシート3には、以下のVBAが設定してあります。 ********************************** Sub osieteinsatsu02() ' Dim start As Long Dim stp As Long Dim i As Long start = Range("a1") stp = Range("c1") For i = start To stp Range("a1") = i Sheets("Sheet2").Select ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True Sheets("sheet3").Select Next End Sub ********************************** ↑ このシートのA1の値(名簿番号)~C1の値の人のデータをシート2に落とし込み、 シート2に行き様式を一枚印刷する。 このように記述してあると思います。 ところで、様式の中に複数名をまとめたいと思いますので、例えば、A1の値を変えるときに4つ置きに変化させるにはどのように記述すれば良いのでしょうか? 1、6、11、16、、、C1の値までで止まる。 どうぞよろしくお願いします。

  • エクセルマクロ

    お世話になります。 下記の記述でどこがおかしいのでしょうか 上手く印刷できません。 Sub Macro13() ' ' 'Dim i As Long For i = 1 To 4 Range("Ai:Ei").Select Selection.Copy Sheets("カード").Select Range("G1:K1").Select Selection.Paste Range("A1:F21").Select Application.CutCopyMode = False ActiveSheet.PageSetup.PrintArea = "$A$1:$F$21" ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate _ :=True Next i End Sub

  • エクセルののマクロについて教えてください

    Sub search() Dim i As Long, lastCol As Long, c As Range, str As String, wS As Worksheet Set wS = Worksheets("sheet2") wS.Cells.Clear str = Application.InputBox("検索内容を入力") Application.ScreenUpdating = False With Worksheets("sheet1") lastCol = .Cells(1, Columns.Count).End(xlToLeft).Column .Columns(lastCol + 1).Insert For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row Set c = Range(.Cells(i, "A"), .Cells(i, lastCol)).Find(what:=str, LookIn:=xlValues, lookat:=xlWhole) If Not c Is Nothing Then .Cells(i, lastCol + 1) = 1 End If Next i If WorksheetFunction.CountIf(.Columns(lastCol + 1), 1) > 0 Then .Range("A1").AutoFilter field:=lastCol + 1, Criteria1:=1 .Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy wS.Range("A1") wS.Columns.AutoFit wS.Columns(lastCol + 1).Delete wS.Activate .Columns(lastCol + 1).Delete .AutoFilterMode = False Else MsgBox "該当データなし" End If End With Application.ScreenUpdating = True End Sub エクセルで上のシステムをネットから持ってきました。 上から5行目のinputboxを"Sheet3"のA列からデータを持ってきてプルダウンで表示させたいのですがユーザーフォームでオブジェクトを組まないで表示させる方法を教えてください

  • マクロ 連続印刷

    マクロ初心者です。 ピボットテーブルでマクロを使って連続印刷をしようと思いました。 一応やってみて連続で印刷は出来たのですが番号がないときエラーになってしまします。 たとえば"562"という番号がないときエラーになって止まってしまいます。 番号がないときは飛ばして印刷するにはどのようにしたらよいでしょうか? よろしくお願いします。 Sub 連続印刷() ' ' 連続印刷 Macro ' ' ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _ IgnorePrintAreas:=False ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("コンポコード").ClearAllFilters ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("コンポコード").CurrentPage = _ "562" ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _ IgnorePrintAreas:=False ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("コンポコード").ClearAllFilters ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("コンポコード").CurrentPage = _ "947" ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _ IgnorePrintAreas:=False ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _ IgnorePrintAreas:=False ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("コンポコード").ClearAllFilters ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("コンポコード").CurrentPage = _ "950" ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _ IgnorePrintAreas:=False ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("コンポコード").ClearAllFilters ActiveSheet.PivotTables("ピボットテーブル1").PivotFields("コンポコード").CurrentPage = _ "952" End Sub

  • Excelの三つのVBAを一つにまとめる。

     初めまして、よろしくお願いします。当方全くの素人でVBAの基礎もよくわからず、ネットから拾ってきていじった三つのVBAがあります。この三つ、一つ一つは個別に機能するのですが、VBAとして正しいのかさえよく解っていません。この三つを一つにまとめて、同時に機能するようにしたいと頭を抱えています。 Sub TEST() Application.ScreenUpdating = False Application.EnableEvents = False ActiveSheet.Calculate Range("b10:b20").Insert shift:=xlShiftToRight Range("b10:b20").Value = Range("a10:a20").Value Application.OnTime TimeValue("09:00:00"), "TEST" Application.ScreenUpdating = True Application.EnableEvents = True ActiveWorkbook.Save End Sub ________________________________________________________________ Sub TEST1() Application.ScreenUpdating = False Application.EnableEvents = False ActiveSheet.Calculate Dim myCnt As Long Range("c30:c40").Copy Range("d30:d40").PasteSpecial Paste:=xlPasteValues Range("b30:b40").Copy Range("c30:c40").PasteSpecial Paste:=xlPasteValues Range("a30:a40").Copy Range("b30:b40").PasteSpecial Paste:=xlPasteValues nextTime = Now() + TimeValue("01:00:00") Application.OnTime nextTime, "TEST1" Application.ScreenUpdating = True Application.EnableEvents = True ActiveSheet.Calculate ActiveWorkbook.Save End Sub ________________________________________________________________ Sub TEST2() Application.ScreenUpdating = False Application.EnableEvents = False ActiveSheet.Calculate Dim myCnt As Long Range("c50:c60").Copy Range("d50:d60").PasteSpecial Paste:=xlPasteValues Range("b50:b60").Copy Range("c50:c60").PasteSpecial Paste:=xlPasteValues Range("a50:a60").Copy Range("b50:b60").PasteSpecial Paste:=xlPasteValues nextTime = Now() + TimeValue("00:10:00") Application.OnTime nextTime, "TEST2" Application.ScreenUpdating = True Application.EnableEvents = True ActiveSheet.Calculate ActiveWorkbook.Save End Sub ________________________________________________________________  解る方、よろしくお願いします。

  • Excel エクセル マクロ VBA

    エクセルマクロで指定したシート(2シート目)から末尾のシートまで印刷したい場合、下記のようなコードで良いでしょうか? Sub Sample1() Dim i As Long For i = 2 To Sheets.Count ActiveWorkbook.Sheets(i).Select (Replace:= False) Next i Activesheet.PrintOut Preview:=True End Sub

  • Excelマクロについて

    先日、OKWEBで教えてもらったマクロに手を加えて作ろうとしたのですが、エラーがでて動かなくなりました。 わかる方がいましたら教えてください。 よろしくおねがいします。 Sub 見積書() Application.ScreenUpdating = False '見積書(完成)シートを選択 Sheets("見積書(完成)").Select '行の高さを「15」にする。 Rows("6:67").Select Range("F6").Activate Selection.RowHeight = 15 'S列のS6:S56をコピーしてE6:E7に貼り付ける。 Range("S6:S56").Select Selection.Copy Range("E6:E7").Select ActiveSheet.Paste '5列目(工数)が「0」のとき該当する行の高さを「0」にする。 For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1 If Cells(i, 5).Value = "0" And Cells(i, 7).Value = "0" Then Rows(i).RowHeight = 0 End If Next '「E8:E55」の範囲を四捨五入する。 For i = ActiveSheet.UsedRange.Rows.Count To 1 Step -1 Range("E8:E55") = Application.Round(Range("E8:E55"), 0) '工数を四捨五入 Next 'C列の中に含まれる「小計」を検索しそこから6列目が「0」だったら行の高さを「0」にする。 Dim Rng As Range Const Retu = "C" For Each Rng In Range(Retu & "1", Range(Retu & "100").End(xlUp)) If Trim(Rng.Value) = "小   計" And _ Rng.Offset(, 6) = 0 Then Rng.EntireRow.Hidden = True End If Next Rng End Sub

  • EXCEL マクロ につきまして

    お世話になっております。 以前、同様の質問をさせていただきまして、 その拡張バージョンをつくりたいと考えております。 Sub macro1() Dim myPath As String Dim myFile As String Dim c As Long Dim LastRowr As Long Application.ScreenUpdating = False myPath = ThisWorkbook.Path & "\" myFile = Dir(myPath & "*.xls") c = 6 Do Until myFile = "" If myFile <> ThisWorkbook.Name Then Workbooks.Open Filename:=myPath & myFile lastrow = Worksheets("特定のシート").Range("A65536").Row ThisWorkbook.Worksheets(2).Cells(1, c).Resize(lastrow, 1).Value = Worksheets("特定のシート").Range("H1").Resize(lastrow, 1).Value Workbooks(myFile).Close False c = c + 1 End If myFile = Dir() Loop Application.ScreenUpdating = True On Error Resume Next ActiveSheet.Name = Format(Date, "mmdd") On Error GoTo 0 End Sub こちらは"特定のシート"の特定の列(H)のみをひたすらフォーマットに 貼り付けていくものですが、コピペしたい列が増えた場合(数は一定ではない) のバージョンができればと思っております。 正直まったくわかりません。 1)データが何列あるかは不定 2)行1~3には自動的に何らかのデータが振られてしまっており(連番等)  データの終わりとして使えそうなのは、行4に「0」が入っていること  (但し0は非表示にしております) "特定のシート"名・データがH列から始まる等は変わりません。 現状の記述を改修、もしくは全とっかえでも構いません。 なにとぞよろしくお願い致します。

専門家に質問してみよう