人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

【エクセルマクロ】に詳しい方教えて下さい。

以下のマクロを
印刷用シートの AV1 を検索値 として
データシートの D列には関数が入っていてある条件にあったセルに正の整数が返る様になっています。
データシートの A列には1から順番に数字が入っています。


データシートのD列に数字が入っているレコードのA列の番号を印刷用シートのAV1に順番に入れて印刷してD列の全てが印刷出来るようにしたいと思っています。

このマクロのどの部分を直せばいいか教えて下さい。宜しくお願いします。


Option Explicit
Option Base 0

Sub test()

Dim PrintSheet As Worksheet
Dim DataSheet As Worksheet
Dim r As Long

Set PrintSheet = Worksheets("印刷用シート")
Set DataSheet = Worksheets("データシート")

r = 2

Do While DataSheet.Cells(r, 1).Value <> ""
If DataSheet.Cells(r, 2).Value => 1 Then

PrintSheet.Cells(1, 1).Value = DataSheet.Cells(r, 1).Value

PrintSheet.Calculate

PrintSheet.PrintOut
End If
r = r + 1
Loop

End Sub

●質問者: mokachan
●カテゴリ:コンピュータ 学習・教育
✍キーワード:as base LOOP SET sub
○ 状態 :終了
└ 回答数 : 2/2件

▽最新の回答へ

1 ● SALINGER
●35ポイント

とりあえず

If DataSheet.Cells(r, 2).Value => 1 Then

PrintSheet.Cells(1, 1).Value = DataSheet.Cells(r, 1).Value

のところはD列と、AV1ということで

If DataSheet.Cells(r, 4).Value => 1 Then

PrintSheet.Cells(1, 48).Value = DataSheet.Cells(r, 1).Value
◎質問者からの返答

回答ありがとうございます。

実は、ご指摘の内容は実証してみたんです。

でも1枚印刷するだけで後が印刷出来ないんです。


2 ● devichan
●35ポイント

こんなやり方も、あるという事で、みてください。

これは、cellじゃなくRangeで指定する場合です。

(sortとか貼り付けの例としてみてください)

(随分前に作ったものを引っ張り出しているので、まちがいがあるかもしれません)

Sub test()

Dim PrintSheet As Worksheet

Dim DataSheet As Worksheet

Dim r As Long

Set PrintSheet = Worksheets("印刷用シート")

Set DataSheet = Worksheets("データシート")

r = 1
'D列で sort
 DataSheet.Select
 Range("A1").Select
 Range("a1").Activate
 Selection.End(xlToLeft).Select
 Selection.End(xlUp).Select
 Range(Selection, Selection.End(xlDown)).Select
 Range(Selection, Selection.End(xlToRight)).Select
 Application.CutCopyMode = False
 Selection.sort Key1:=Range("D1"), Order1:=xlAscending, Key2:=Range("AD2" _
 ), Order2:=xlAscending, Key3:=Range("M2"), Order3:=xlAscending, Header _
 :=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom _
 , SortMethod:=xlPinYin
 Range("A1").Select
 Range("a1").Activate
'データ量抽出 参考
' DataSheet.Select
' Range("A1").Select
' Range("a1").Activate
' Selection.End(xlToLeft).Select
' Selection.End(xlDown).Select
'          Selection.Rows.Row ←この時の、この値が最終行
' おまじない
 PrintSheet.Select

Do While DataSheet.Range("d" & r ).Value <> ""

If DataSheet.Range("d" & r ).Value >= 1 Then

'データの値のみコピー(セル値=式としてはコピーしません)

DataSheet.Range("a" & r).Copy

PrintSheet.Range("AV1").PasteSpecial Paste:=xlPasteValues, _

Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'一応コメント
' PrintSheet.Calculate

PrintSheet.PrintOut

End If

r = r + 1

Loop

End Sub


'プリンタの選択例

' Application.ActivePrinter = "プリンターです on Ne01:"

'プリンタのセットアップ例

Sub prt_set()

With ActiveSheet.PageSetup

.LeftHeader = ""

.CenterHeader = "&18&Uヘッダータイトル等"

.RightHeader = "" & Chr(10) & " &P頁"

.LeftFooter = ""

.CenterFooter = ""

.RightFooter = ""

.LeftMargin = Application.InchesToPoints(0.68)

.RightMargin = Application.InchesToPoints(0.43)

.TopMargin = Application.InchesToPoints(1.10236220472441)

.BottomMargin = Application.InchesToPoints(0.62)

.HeaderMargin = Application.InchesToPoints(0.78740157480315)

.FooterMargin = Application.InchesToPoints(0.393700787401575)

.PrintHeadings = False

.PrintGridlines = False

.PrintComments = xlPrintNoComments

.CenterHorizontally = False

.CenterVertically = False

.Orientation = xlLandscape

.Draft = False

.PaperSize = xlPaperA4

.FirstPageNumber = xlAutomatic

.Order = xlDownThenOver

.BlackAndWhite = False

.Zoom = 92

' ↓エラーになるのでコメント

' .PrintErrors = xlPrintErrorsDisplayed

End With

ActiveWindow.SelectedSheets.PrintPreview

End Sub

◎質問者からの返答

いろいろありがとうございました。

後でじっくり試してみたいと思います。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ