[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『プリンタの指定』（みほ）
現在下記ｺｰﾄﾞにて、ﾃﾞｰﾀの追番をﾌｫｰﾑに入力したらﾃﾞｰﾀが印刷ﾌｫｰﾏｯﾄに 自動転記されて印刷される。というのを作成してます。追番はｶﾝﾏやﾊｲﾌﾝで区切って 入力することにより、複数枚の印刷指定も可能にしてます。 以前は個人ごとにファイルを持って作業してたので、ﾌﾟﾘﾝﾀの名前や印刷設定も個別に 設定できたのですが、今回１ファイルにまとめて共有する事になり、 この掲示板の例に習いましてﾌﾟﾘﾝﾀの選択とﾄﾚｲ等設定できるようになったのですが、 複数枚印刷をする時に、枚数分OKボタンを押さないといけなくて、何とかしたいのですが 方法があれば教えていただけませんか？
Sub TEST()
Dim myStr As String
Dim myArray() As String
Dim a() As String
Dim i As Long , j As Long
Dim WS1, WS2 As Worksheet
Set WS1 = Worksheets("台帳")
Set WS2 = Worksheets("印刷ﾌｫｰﾏｯﾄ")
myStr = InputBox("入力")
myArray() = Split(myStr, ",")
For i = 0 To UBound(myArray)
'1-3を1,2,3に変換する
If InStr(myArray(i), "-") Then
a = Split(myArray(i), "-")
myArray(i) = ""
For j = a(0) To a(1)
If myArray(i) = "" Then
myArray(i) = j
Else
myArray(i) = myArray(i) & "," & j
End If
Next j
End If
Next i
Application.ScreenUpdating = False
myStr = Join(myArray, ",") '配列をカンマ区切りの文字列に戻し
myArray = Split(myStr, ",") '再度、配列に入れる
For i = 0 To UBound(myArray)
'ﾌｫｰﾏｯﾄに転記
WS2.Range("C3").Value = _
WS1.Cells(myArray(i) + 1, 1).Value
WS2.Range("H4").Value = _
WS1.Cells(myArray(i) + 1, 14).Value
WS2.Range("B8").Value = _
WS1.Cells(myArray(i) + 1, 8).Value
WS2.Range("B9").Value = _
WS1.Cells(myArray(i) + 1, 7).Value
WS2.Range("M11").Value = _
WS1.Cells(myArray(i) + 1, 12).Value
WS2.Range("O11").Value = _
WS1.Cells(myArray(i) + 1, 13).Value
WS2.Range("P13").Value = _
WS1.Cells(myArray(i) + 1, 3).Value
WS2.Range("R13").Value = _
WS1.Cells(myArray(i) + 1, 4).Value
WS2.Range("P14").Value = _
WS1.Cells(myArray(i) + 1, 9).Value
WS2.Range("P15").Value = _
WS1.Cells(myArray(i) + 1, 11).Value
WS2.Range("V5").Value = _
WS1.Cells(myArray(i) + 1, 5).Value
'従来の方法 'Application.ActivePrinter = "RICOH IPSiO NX760 on Ne00:" 'ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, _ 'ActivePrinter:="RICOH IPSiO NX760 on Ne00:", Collate:=True
'現在はこちらです。
Dim tmp As Variant
tmp = Application.Dialogs(xlDialogPrinterSetup).Show
If tmp = False Then Exit Sub
ActiveSheet.PrintOut
Next i Application.ScreenUpdating = True End Sub
ActiveSheet.PrintOut
↑を
'ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, _
↑がコピー部数指定なので
↓はインプットボックスで部数指定する方法です
myBusuu = CInt(InputBox("部数を指定して下さい"))
ActiveSheet.PrintOut Copies:=myBusuu
とかにすれば必要な部数印刷出来ると思いますよ。
(力技)
力技さん回答ありがとうございます。 ん〜私が何か間違っているかもしれませんが、やはり指定した枚数分OKボタンを押す ようになるのですが。。。 tmp = Application.Dialogs(xlDialogPrinterSetup).Show ←これのOKボタンです。 部数を指定をはさんでもやはり 1-5や1,3,6,8,9 で印刷指定するとOKを5回押すことに。。 ちなみに印刷ﾌｫｰﾏｯﾄは改ページﾌﾟﾚﾋﾞｭｰの所で１ページ分の範囲のみに設定してます。
Collate:=True ↑が必要でした(部単位で印刷の指定です) ActiveSheet.PrintOut Copies:=tmp,Collate:=True でしたすみません。またこの後会議なので多分次は月曜日になるかと･･･ (力技)
力技さん、お忙しい所本当にすみません！ 早速、午前中にお試しさせて頂いたのですが、今度は追番で1,3を指定しても、 印刷して出てくるのは追番1が二枚になるのですが、 現在はデータ転記後、いきなり Application.Dialogs(xlDialogPrinterSetup).Show を出して OKを枚数分押すのを回避できないかやってるのですが。。
済みませんせんでした。
私が仕様を勘違いしてたみたいで･･･
「複数部数出し」ではなく「複数ページ指定して出す」なのですねTT;
>'現在はこちらです。
の下の所を↓にしてみて下さい。
(力技)
Dim tmp As Variant
tmp = Application.Dialogs(xlDialogPrinterSetup).Show
If tmp = False Then Exit Sub
'↓格納されているページ指定の数を取得
myPage = UBound(myArray)
For x = 0 To myPage
'↓印刷開始ページ指定
ActiveSheet.PrintOut From:=myArray(x), to:=myArray(x)
'↑終了ページ指定
Next x
私の説明の悪さとそして、重ね々すみません。追番1,3 or 1-2指定印刷で やはりまだ最初の追番1が二枚でるんですが、現在〜以下が下記コード なのですが、私の宣言分とか間違ってますか？？
'現在はこちらです。 の以下
Dim tmp As Variant
Dim myPage As String
Dim x As Long
'Setupだと設定ボタンを押すと通常使用のﾌﾟﾘﾝﾀ設定しかできないようなので、
(xlDialogPrint)にしました
tmp = Application.Dialogs(xlDialogPrint).Show
If tmp = False Then Exit Sub
'↓格納されているページ指定の数を取得
myPage = UBound(myArray)
For x = 0 To myPage
'↓印刷開始ページ指定
ActiveSheet.PrintOut From:=myArray(x), to:=myArray(x)
'↑終了ページ指定
Next x
Next i
Application.ScreenUpdating = True
End Sub
１つ前の文の訂正です。申し訳ありません。
'現在はこちらです。 の以下 Dim tmp As Variant Dim myPage As String Dim x As Long
'印刷用紙がA5の為、ﾄﾚｲ2の人、手差しの人と設定する必要があるので 'Setupの設定ボタンを押すと通常使用のﾌﾟﾘﾝﾀ設定しかできないようなので、 '(xlDialogPrint)にしました
tmp = Application.Dialogs(xlDialogPrint).Show
If tmp = False Then Exit Sub
'↓格納されているページ指定の数を取得
myPage = UBound(myArray)
For x = 0 To myPage
'↓印刷開始ページ指定
ActiveSheet.PrintOut From:=myArray(x), to:=myArray(x)
'↑終了ページ指定
Next x
Next i
Application.ScreenUpdating = True End Sub
>tmp = Application.Dialogs(xlDialogPrint).Show だと「OK」を押した後に印刷されてませんか？ 私が確認した所ではそうでしたので、 For x = 1 To myPage ↑の様にmyArray(0)からでは無くmyArray(1)から印刷するようにしてみて下さい。 (力技)
>For x = 1 To myPage ↑の様にmyArray(0)からでは無くmyArray(1)から印刷するようにしてみて下さい。 こちらをやってみてもやはりうまくいきませんでした。何故なんでしょう〜(恥)
力技さん、どうもお手数をおかけ致しました。m(._.)m これ以上ご迷惑はかけられませんので、またいろいろ自分で試してみます。 ありがとうございました。
>こちらをやってみてもやはりうまくいきませんでした。 ↑どのように「上手くいかない」のでしょうか？ >tmp = Application.Dialogs(xlDialogPrint).Show 私のテストでは↑の所は追番1だけ指定して「OK」を押してました
多分なさりたい事は 出力先プリンターを指定→指定ページを印刷 別のHPですが参考になるかと http://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=7665;id=excel >これ以上ご迷惑はかけられませんので いえいえ こちらも調べ物とかして勉強になります。 力量不足ですみません。 (力技)
温かいお言葉感謝です！！
もう一度やりたい事を整理いたしますと、印刷したい追番を入力ﾌｫｰﾑに半角数字で入力。 1枚のみ指定だと現状で十分だと思います。
しかし連続で入力ﾌｫｰﾑに 1-5 と打ち込んで、1〜5までを1枚づついっきに印刷や、 入力ﾌｫｰﾑに 1,3,5 とと打ち込んで、番号がとんでいる1と3と5を1枚づついっきに印刷。 といった漢字です。 そこで Application.Dialogs(xlDialogPrint).Showを出して ﾌﾟﾘﾝﾀを選んでからプロパティで給紙ﾄﾚｲを選んでOKを押して画面を戻し、 またOKを押すと印刷されます。 しかしこの時に1-5ならOKを5回、1,3,5ならOKを3回、押さないと指定追番を印刷しません。 OKが1回で済むようにと思うのですが、今のところ1しか印刷できない。書き方をいじっても 5しか出ない、1が5枚でる等うまくいかないのです。
>http://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=7665;id=excel ↑もぜひ拝見させていただきますね。(みほ)
ちなみに私がテストしてたものをUPしておきます 印刷したいシートをアクティブにして実行してみて下さい。 （紹介したHPのコードを改造しようかと思いましたが・・・ 解析にまだ時間がかかりそうなので・・・） (力技)
Sub Macro28()
Dim tmp As Variant
Dim myArray() As String
Dim myPage As String
Dim x As Long
myStr = InputBox("入力")
myArray() = Split(myStr, ",")
For i = 0 To UBound(myArray)
'1-3を1,2,3に変換する
If InStr(myArray(i), "-") Then
a = Split(myArray(i), "-")
myArray(i) = ""
For j = a(0) To a(1)
If myArray(i) = "" Then
myArray(i) = j
Else
myArray(i) = myArray(i) & "," & j
End If
Next j
End If
Next i
Application.ScreenUpdating = False
myStr = Join(myArray, ",") '配列をカンマ区切りの文字列に戻し
myArray = Split(myStr, ",") '再度、配列に入れる
'Setupだと設定ボタンを押すと通常使用のﾌﾟﾘﾝﾀ設定しかできないようなので、
'(xlDialogPrint)にしました
tmp = Application.Dialogs(xlDialogPrint).Show
If tmp = False Then Exit Sub
'↓格納されているページ指定の数を取得
myPage = UBound(myArray)
For x = 1 To myPage
'↓印刷開始ページ指定
ActiveSheet.PrintOut From:=myArray(x), To:=myArray(x)
'↑終了ページ指定
Next x
Application.ScreenUpdating = True End Sub
見て下さってるのですね。ありがとうございます。 どうやら私のｺｰﾄﾞでﾃﾞｰﾀ転記をするFor〜Nextで、Next i がどこにあるかで変わります。
OKを押すのは１回で済むようになったのですが、
Next x の後ろにNext i を持ってくると、1-2なら、1のみ1枚出ます。
For i = 0 To UBound(myArray)
'ﾌｫｰﾏｯﾄに転記
WS2.Range("C3").Value = _
WS1.Cells(myArray(i) + 1, 1).Value
↓省略
WS2.Range("V5").Value = _
WS1.Cells(myArray(i) + 1, 5).Value
Next i
とすると1-2なら、2のみ1枚出ます。
今度は最初か最後の1枚しか出ずお悩み中です。
(みほ)
今日は１７：００位まではまとまった時間が取れそうなので
最初から再度読み直していました。ら、
済みません 仕様をぜんぜん読み間違いしてました。
tmp = Application.Dialogs(xlDialogPrint).Show
を ↓に
If tmp = Empty Then tmp = Application.Dialogs(xlDialogPrint).Show
後、
For x = 1 To myPage
ActiveSheet.PrintOut From:=myArray(x), To:=myArray(x)
Next x
を ↓に
if i > 0 Then ActiveSheet.PrintOut From:=myArray(i), To:=myArray(i)
(力技)
力技さん、長い間ほんとうにお世話になっております。 前半は省略しました。最後の数行をこのようにしたのですが、 まだ一枚しかでません。 (みほ)
WS2.Range("P15").Value = _
WS1.Cells(myArray(i) + 1, 11).Value
WS2.Range("V5").Value = _
WS1.Cells(myArray(i) + 1, 5).Value
If tmp = Empty Then tmp = Application.Dialogs(xlDialogPrint).Show
If tmp = False Then Exit Sub
If i > 0 Then ActiveSheet.PrintOut From:=myArray(i), To:=myArray(i)
Next i
Application.ScreenUpdating = True End Sub
Dim myStr As String
Dim myArray() As String
Dim a() As String
Dim i As Long, j As Long
Dim WS1, WS2 As Worksheet
Set WS1 = Worksheets("台帳")
Set WS2 = Worksheets("印刷ﾌｫｰﾏｯﾄ")
myStr = InputBox("入力")
myArray() = Split(myStr, ",")
For i = 0 To UBound(myArray)
'1-3を1,2,3に変換する
If InStr(myArray(i), "-") Then
a = Split(myArray(i), "-")
myArray(i) = ""
For j = a(0) To a(1)
If myArray(i) = "" Then
myArray(i) = j
Else
myArray(i) = myArray(i) & "," & j
End If
Next j
End If
Next i
Application.ScreenUpdating = False
myStr = Join(myArray, ",") '配列をカンマ区切りの文字列に戻し
myArray = Split(myStr, ",") '再度、配列に入れる
For i = 0 To UBound(myArray)
'ﾌｫｰﾏｯﾄに転記
WS2.Range("C3").Value = _
WS1.Cells(myArray(i) + 1, 1).Value
WS2.Range("H4").Value = _
WS1.Cells(myArray(i) + 1, 14).Value
WS2.Range("B8").Value = _
WS1.Cells(myArray(i) + 1, 8).Value
WS2.Range("B9").Value = _
WS1.Cells(myArray(i) + 1, 7).Value
WS2.Range("M11").Value = _
WS1.Cells(myArray(i) + 1, 12).Value
WS2.Range("O11").Value = _
WS1.Cells(myArray(i) + 1, 13).Value
WS2.Range("P13").Value = _
WS1.Cells(myArray(i) + 1, 3).Value
WS2.Range("R13").Value = _
WS1.Cells(myArray(i) + 1, 4).Value
WS2.Range("P14").Value = _
WS1.Cells(myArray(i) + 1, 9).Value
WS2.Range("P15").Value = _
WS1.Cells(myArray(i) + 1, 11).Value
WS2.Range("V5").Value = _
WS1.Cells(myArray(i) + 1, 5).Value
If tmp = Empty Then tmp = Application.Dialogs(xlDialogPrint).Show
If tmp = False Then Exit Sub
If i > 0 Then ActiveSheet.PrintOut From:=myArray(i), To:=myArray(i)
Next i Application.ScreenUpdating = True
こうなんですよね？ 印刷はmyArray(i)のページを印刷するのでmyArray(i)に値が入っていない可能性が･･･ ただ私の所では「1-2,4,6」だと1P,2P,4P,6Pとちゃんと印刷されてしまうので
MsgBox myArray(i) & " P目を印刷します。
をPrintOutの前に追加してみてください。 (力技)
力技さん、MsgBoxを追加すると私の方も「1-2,4,6」と入ってました。 しかしﾌﾟﾘﾝﾀから出る紙は最初の追番1の1枚のみです。 ただひとつ私とのｺｰﾄﾞの違いがありまして、tmpの宣言の有無です。 Dim tmp As Variant を私の方は宣言しないとｴﾗｰがでるのですが何か関係しますか？ (みほ)
関係しないと思うのですが あまり詳しい方じゃ無いので自信が・・・ Option Explicitとか使用してると全部の変数を宣言しないとエラーになりますけど
>MsgBoxを追加すると あれ？「1-2,4,6」ですか？ 「1」「2」「4」「6」じゃなくて？ myArray(i)に正しく値が入ってないのかな？ >myArray = Split(myStr, ",") '再度、配列に入れる にカーソルをあててF9→マクロ実行→1回F8→「表示→ローカルウィンドウ」の myArryの「+」を押してみて下さい。なんてでてますか？ (力技)
いえ、「1」「2」「4」「6」と４回出てきました。 そしてmyArryの「+」を開くと myArry(0) "1" String myArry(1) "2" String myArry(2) "4" String myArry(3) "6" String でした。(みほ)
では茶色の所（F9押した所）で再度F9 Application.ScreenUpdating = True の所でF9→マクロ実行→ローカルウィンドウの「i」の値が4になってますか？ そろそろ退社時間なので返事は明日になります。 (力技)
おはようございます。 tmp True Variant/Boolean i 4 Long j 3 Long となっております。(みほ)
>If i > 0 Then ActiveSheet.PrintOut From:=myArray(i), To:=myArray(i) なら↑を If i > 0 Then ActiveSheet.PrintOut From:=myArray(i), To:=myArray(i), Collate:=True に変更してみて下さい (力技) 修正 ActiveWindow.SelectedSheets.PrintOut From:=myArray(i), To:=myArray(i), Collate:=True (力技)
>If i > 0 Then ActiveSheet.PrintOut From:=myArray(i), To:=myArray(i), Collate:=True
>ActiveWindow.SelectedSheets.PrintOut From:=myArray(i), To:=myArray(i), Collate:=True 双方試しましたがやはり最初の１枚しか出ないみたいです。 こちらも思いつく限り試し続けてみます。(みほ)
IFステートメントが上手く機能してないのかな
>If i > 0 Then ActiveSheet.PrintOut From:=myArray(i), To:=myArray(i), Collate:=True
↑を↓に変更して下さい。
Select Case i
Case Is >= 1
ActiveSheet.PrintOut From:=myArray(i), To:=myArray(i), Collate:=True
End Select
PrintOutをF9してからマクロを実行してもらえると「i」がきちんと判定されてるか判るのでお願いします
(力技)
結果は同じですね。。力技さんのﾌﾟﾘﾝﾀでは指定枚数が出てくるのですよね。 私のﾊﾟｿｺﾝの環境が何か違うのですかね。。。 P.S. この件に関して力技さん、どうかくれぐれもお仕事にさしつかない程度で お願い致しますね。私は申し訳なくて、申し訳なくて、、 (みほ)
If tmp = Empty Then tmp = Application.Dialogs(xlDialogPrint).Show
If myPrt = Empty Then myPrt = Application.ActivePrinter
If tmp = False Then Exit Sub
Select Case i
Case Is >= 1
Application.ActivePrinter = myPrt
ActiveSheet.PrintOut From:=myArray(i), To:=myArray(i), Collate:=True, ActivePrinter:=myPrt
End Select
Next i
プリンターを毎回指定してみました。
業務の合間・合間で行ってるので大丈夫です。 お心使いありがとうございます。 (力技)
> Case Is >= 1 ↓↑ > If i > 0 上下は、0より大きいときは印刷すると同じ意味だと思うので
どうやら最初の1枚はiが0のときなので、「最初の１枚しか出てこない」ではなく
「最初の１枚以外が出てくる」のでは？?ということで
For i = 0 To UBound(myArray)
MsgBox i + 1 & "枚目は、" & myArray(i) & "P目です"
Next i
として、InputBoxに入力したものと、MsgBoxで表示されるものを
比べて意図した通りになっているかどうか確認中に至りました！(みほ)
>「最初の１枚以外が出てくる」のでは？? そうです。 >If tmp = Empty Then tmp = Application.Dialogs(xlDialogPrint).Show 私の所では↑で先頭Pが印刷されてしまいます。 なので1p目がダブらないように最初の「i=0」の時は印刷されない様にしてました。 Dialogsの所で印刷され無いのでしたら「If〜Then」は要りませんね すみませんでした。 (力技)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.