VBAで休暇願を両面印刷する方法

このQ&Aのポイント
  • VBAで休暇願を作成し、差し込み印刷方法を使用してA4用紙に両面印刷する方法を教えてください。
  • 提供されたマクロでは片面印刷が可能ですが、両面印刷にするためにはどのように書けばよいですか?
  • マクロの内容を添付していますので、両面印刷できるように修正する方法を教えてください。
回答を見る
  • ベストアンサー

休暇願をVBA作成し両面印刷する方法を教えてほしい

VBAで休暇願を作成し印刷時は差し込み印刷方法でA4用紙に両面印刷したいのですが書き方が判りません。 マクロの内容を添付しますので両面印刷できるようにするにはどのように書けばよいのか教えてください。 下記のマクロで片面印刷は可能です。 Sub 印刷() Dim LastRow As Long Dim i As Long Dim myNo As Long If vbNo = MsgBox("印刷を開始していいですか?", vbYesNo) Then Exit Sub With Worksheets("名簿マスター") LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row For i = 1 To LastRow myNo = .Range("A" & i).Value With Worksheets("印刷シート") .Range("f7").Value = myNo .PrintOut Copies:=1, Collate:=True End With Next i End With MsgBox "印刷が終わりました" End Sub

noname#248032
noname#248032

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

  • ベストアンサー
  • watabe007
  • ベストアンサー率62% (476/760)
回答No.4

プリンタードライバを追加してディフォルトで両面印刷するように設定 インストールしたプリンターのアイコンを右クリックして [印刷設定]をクリック ⇒ 両面印刷の設定 設定後、プリンター名を"両面印刷"とする Sub 印刷()   Dim LastRow As Long   Dim i As Long   Dim myNo As Long   Dim myPrinter As String   If vbNo = MsgBox("印刷を開始していいですか?", vbYesNo) Then Exit Sub   'アクティブプリンターを記録   myPrinter = Application.ActivePrinter   With Worksheets("名簿マスター")     LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row     For i = 1 To LastRow       myNo = .Range("A" & i).Value       With Worksheets("印刷シート")         .Range("f7").Value = myNo         '両面印刷をデフォルトで設定したプリンターで印刷         .PrintOut ActivePrinter:="両面印刷", Copies:=1       End With     Next i   End With   'アクティブプリンタを通常のプリンタに戻す。   Application.ActivePrinter = myPrinter   MsgBox "印刷が終わりました" End Sub

その他の回答 (3)

  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.3

検索して、WEBページに聞けば、すぐわかる有名な課題。 http://www.max.hi-ho.ne.jp/happy/YNxv9b8.html >2. プリンターのオプション設定 両面印刷のようにプリンターのドライバーの機能に依存するものは、マクロを自動記録することは不可能と思います。 推測では、多分メーカーでのこの面のドライバー(機器仕様密着の)ソフトでの標準化・共通化がなされる前に、エクセルVBAなどのしよう仕様が決まって、そのままになっているのでは? (1)常時、両面印刷になっているプリンターを決めて、アクチブプリンター に指定するか、 (2)SendKeys法 があるが、(2)は簡易でなく、(1)は完全ではなさそうだ(それまでに、誰かが片面に変更可能)。 VBAでは諦めて、印刷するとき、直前に、自分でパソコン画面で、両面印刷の設定ができるのではないか。小生はやむなくそうしている。 また、この機能がプリンターにハード的に備わってない機種では、話にならない。 ページごとに、用紙の表に印刷して、用紙を裏返して、裏ページ内容を印刷する、とかも煩雑だ。

  • kybo
  • ベストアンサー率53% (349/647)
回答No.2

プリンタのプロパティを設定変更して印刷したいのだと思いますが、その部分はExcelではないのでVBAで制御できません。 特定のPCで特定のプリンタなら以下の手順で最初から両面印刷に設定しておくことをお勧めします。 ページレイアウトのタブからページ設定の画面を表示します。 下のオプションをクリックして、両面印刷にして、すべてOKし、 ファイルを保存します。

  • f272
  • ベストアンサー率46% (7964/17024)
回答No.1

両面印刷とかの制御はVBAではできません。 両面印刷になるような設定をしたプリンタを作成して,そのプリンタで印刷するようにしてください。 .PrintOut ActivePrinter: = "両面プリンタ"

関連するQ&A

  • エクセル マクロ 方法

    以下のようなマクロを作りましたが、帳票を印刷すると1枚印刷されます。 ですが、この帳票がA5サイズの決まりがあり、かつプリンタがA4しか用紙を入れることができないので、 そのため、一度にA5サイズの帳票を2枚合わせた形で印刷をさせたいと考えています。 A4用紙に左側(名簿の1番目)右側(名簿の2番目) 次も、名簿の3番目・4番目と連続印刷をしたいのですが、どのようにすれば良いのでしょうか。 勉強不足で申し訳ございませんが、ご指南くださいますようお願いいたします。 Sub 帳票印刷() Dim LastRow As Long Dim i As Long Dim myNo As Variant With Worksheets("名簿") LastRow = .Cells(Application.Rows.Count, "A").End(xlUp).Row For i = 2 To LastRow myNo = .Range("A" & i).Value With Worksheets("印刷用") .Range("C4").Value = myNo .PrintPreview .PrintOut Copies:=1, Collate:=True   End With Next i End With End Sub

  • VBAで印刷処理の設定

    メインシートで、印刷ボタンを押した際に、 設定値に基づいて、条件分岐するには、どうすればいいでしょうか。 ご教授お願いいたします。 ★シート名 ・メインシート ・名簿 ・設定 の3つのシートがあります。 メインシートには、入力項目があります。 名簿には、 No. 会社名 担当 印刷 ・ ・ ・ のセルがあります。 印刷列は、 「0」or「1」の指定がされています。 0の場合は、印刷しない。 1の場合は、印刷する。 設定シートには、 項目 値 列があります。 項目1には、「プレビュー表示」があり、 値には、「プレビュー表示する」or「プレビュー表示しない」が 設定されます。 Sub 連続印刷() Dim i As Integer Dim LastRow As Integer Worksheets("メインシート").Select With Worksheets("名簿") LastRow = .Range("A65536").End(xlUp).Row For i = 2 To LastRow Range("A4").Value = .Range("A" & i).Value ' プレビュー表示分岐 With Worksheets("設定") ' Cells(行番号, 列番号) If Cells(2, 2).Value = "1" Then ' プレビュー確認 ActiveSheet.PrintPreview ElseIf Cells(2, 2).Value = "プレビュー表示しない" Then ' 確認なしで印刷 ActiveSheet.PrintOut Else ' プレビュー確認 ' ActiveSheet.PrintPreview MsgBox ("test") End If End With Next End With End Sub

  • エクセルのフォームのVBAについて

    VBAがまったくわからないのに参考書を見て高度な事に挑戦しています フォームは作れてフォームをクリックやら入力やらして作ったOKボタンを押すと シート2のA1B1C1‥の列に入力文字だけが羅列されます。 しかし次にやろうとするとA2B2C2‥と下に行かず又A1B1C1‥の列の文字が変更になり続きません。何がいけないのでしょうか? Sub 入力() Dim LastRow As Long With Worksheets("sheet2") LastRow = Worksheets("sheet2").Range("A" & Rows.Count).End(xlUp).Row .Range("A" & LastRow).Value = Worksheets("sheet1").Range("A5").Value .Range("B" & LastRow).Value = Worksheets("sheet1").Range("A7").Value .Range("C" & LastRow).Value = Worksheets("sheet1").Range("A8").Value .Range("D" & LastRow).Value = Worksheets("sheet1").Range("A10").Value End With End Sub と参考書とおりいれたのですが‥。教えて下さい。

  • 他のブックでマクロを実行するには?

    以下のマクロを実行すると同一ブック内の他のシートに入力 されますが、これを他のブックのシートに入力されるように するには、具体的にどのようにすればいいのでしょうか? ご教授ください。 ---------------------------------------------------------------- Sub 入力() Dim LastRow As Long With Worksheets("sheet2") LastRow = Worksheets("sheet2").Range("B" & Rows.Count).End(xlUp).Row + 1 .Range("B" & LastRow).Value = Worksheets("sheet1").Range("B1").Value .Range("C" & LastRow).Value = Worksheets("sheet1").Range("B3").Value .Range("D" & LastRow).Value = Worksheets("sheet1").Range("B5").Value .Range("E" & LastRow).Value = Worksheets("sheet1").Range("B7").Value .Range("F" & LastRow).Value = Worksheets("sheet1").Range("B9").Value .Range("G" & LastRow).Value = Worksheets("sheet1").Range("B11").Value End With End Sub

  • 配列に格納したデータを指定行以下に転記する方法

    excel2000を使っています。 以下のコードだと最終行にデータが転記されます。これを4行目に確定して、転記したいのです。常に4行目つまりA列4行目以下に上書きしたいのです。 その場合コードをどのように変更すべきでしょうか? Sub 配列() With ActiveSheet ' 配列に格納 --------------------------- Dim i As Integer Dim LastRow As Long Dim SaleAry As Variant ' 配列に格納 --------------------------- SaleAry = Array(.Range("t4"), .Range("e5"), .Range("g5"), .Range("o5")) End With ' 転記 --------------------------- With Worksheets("daityou") LastRow = .Range("A65536").End(xlUp).Row For i = 0 To UBound(SaleAry) .Cells(LastRow + 1, i + 1).Value = SaleAry(i) ' Next i End With Set SaleAry = Nothing End Sub

  • ListBoxで表示されたデータの取得方法は

    お世話になります。 標準フォーム から以下のリストボックスを表示して、無事シートの一覧が表示されています。 Private Sub UserForm_Initialize() Dim lastRow As Long Dim myData Worksheets("Sheet1").Range("a1:C35").Value = "" With Worksheets(Sheet) myData = .Range(.Cells(1, 1), .Cells(Rows.Count, 3).End(xlUp)).Value End With With ListBox1 .ColumnCount = 3 .ColumnWidths = "20;70;100" .List = myData End With End Sub このリストボックスにはボタンが二つありボタン1を押したときに標準フォームへ[hinban] という変数にリストボックスでフォーカスしているデータを取り込みたいのですが以下の方法でうまくいきません。 Private Sub CommandButton1_Click() Dim lastRow As Long Dim i As Integer hinban = ListBox1.Column(pvargColumn:=1) End Sub もう一つのボタンは何もせずにリストボックスを閉じたいのですがこれで問題ないですか。 Private Sub CommandButton2_Click() Unload Me End Sub プログラム初心者でインターネットから寄せ集めのプログラムです。 どなたかお力をお貸しください。

  • VBA リストボックスについて

    VBA初心者です。どうぞよろしくお願いします。 ユーザーフォームにタブつきのリストボックスを作りたいと思っています。 リストはsheet1の中にあります。   A    B    C    D・・・ 1  NO  品名  売場 2  1  いちご  果物 3  2  みかん  果物 4  3  もも    果物 5  4  ハクサイ 野菜 6  5  キャベツ  野菜 7  6  きゅうり  野菜 8  7 9 果物のタブには、果物の品名が表示される。 1 いちご 2 みかん 3 もも 野菜のタブには、野菜の品名が表示される。 4 ハクサイ 5 キャベツ 6 きゅうり 青果のタブには、果物、野菜が表示される。 1 いちご 2 みかん 3 もも 4 ハクサイ 5 キャベツ 6 きゅうり 本を見ながら格闘しておりますが、きっと的違いで滅茶苦茶なことをしているのだと思います。 どうにも出来ず困っております。どなたか教えていただけないでしょうか。よろしくお願いします。 Private Sub UserForm_Initialize() Dim LastRow As Long Dim i As Integer Dim ListBoxNo As Integer Dim ListBox As Control Dim Listtabu(3) As Long 'タブの数 For i = 1 To 3 Listtabu(i) = 0 Next i Worksheets("sheet1").Activate With Worksheets("sheet1") LastRow = .Range("A65536").End(xlUp).Row For i = 2 To LastRow If Worksheets("sheet1").Range(Cells(i, 3)) = "果物" Then ListBoxNo = 1 Set ListBox = 果物 果物.List = Worksheets("sheet1").Range(Cells(i, 1), Cells(i, 2)).Value End If If Worksheets("sheet1").Range(Cells(i, 3)) = "野菜" Then ListBoxNo = 2 Set ListBox = 野菜 野菜.List = Worksheets("sheet1").Range(Cells(i, 1), Cells(i, 2)).Value End If If Worksheets("sheet1").Range(Cells(i, 3)) = "果物" & "野菜" Then ListBoxNo = 3 Set ListBox = 青果 青果.List = Worksheets("sheet1").Range(Cells(i, 1), Cells(i, 2)).Value End If ListBox.AddItem ListBox.List(Listtabu(LstBxNo), 0) = Worksheets("sheet1").Cells(i, 1).Value ListBox.List(Listtabu(LstBxNo), 1) = Worksheets("sheet1").Cells(i, 2).Value Listtabu(LstBxNo) = Listtabu(LstBxNo) + 1 Next End With End Sub

  • VBA CHANGEイベントに複数イベントを

    いつもお世話になっています。 色々しらべて試してみたんですが、うまくいかないんで教えてください。 CHANGEイベントに複数のイベントを書き込みたいんですが。 今現在、問題なく動いている以下のイベントがあります。 (1) Private Sub Worksheet_Change(ByVal Target As Range) Dim rang3 As Range Dim rang4 As Range Dim ■■ As String Dim LastRow1 As Long LastRow1 = Worksheets("○○").Cells(Rows.Count, "b").End(xlUp).Row Set rang4 = Worksheets("○○").Range("b:I" & LastRow) Set rang3 = Range("h4") If Intersect(Target, rang3) Is Nothing Then Exit Sub On Error Resume Next ■■ = WorksheetFunction.VLookup(Target.Value, rang4, 2, 0) If Err.Number > 0 Then MsgBox Target.Value & "はありません。基本情報台帳に入力してください。" Range("h4").Select Else Application.EnableEvents = False Range("I4").Value = Application.WorksheetFunction.VLookup(Target, Worksheets("△△").Range("b:I"), 2, False) Range("j4").Value = Application.WorksheetFunction.VLookup(Target, Worksheets("△△").Range("b:I"), 3, False) Range("k4").Value = Application.WorksheetFunction.VLookup(Target, Worksheets("△△").Range("b:I"), 7, False) Range("l4").Value = Application.WorksheetFunction.VLookup(Target, Worksheets("△△").Range("b:I"), 8, False) Range("m4").Value = Application.WorksheetFunction.VLookup(Target, Worksheets("△△").Range("b:I"), 5, False) Application.EnableEvents = True Range("K4").Select End If End Sub このシートにもう一つ、イベントを入れたいのですが。 (2) If Target.Count > 1 Then Exit Sub If Intersect(Target, Range("E4")) Is Nothing Then Exit Sub Else If Range("e4").Value = "1" Then Target.Offset(0, 19).Value = "☆" End If どこに入れればいいのかわかりません。 (3) また、(2)のイベントの他に、 (1)のVLOOLUPが実行され、尚且つ(2)のイベントのE4が値が1だった場合、Y4にH4の値を入れたいのですが・・・。 (2)のみなら動くことは確認できましたが、(1)のexit sub の直前に入れたり、end ifの前に入れたりしましたが、片方は動くが、もうひとつが動かないです。 (3)については、まったくわかりません。 マクロについて、自分でネットで勉強した程度なので、基本がわかっていないからなのでしょうが・・・。 どなたか、教えてください。 お願いします。

  • 教えてマクロの記述?

    シート1に記述した内容をシート2に一覧形式で入力するマクロを以下の通り作成しました。 シート1に記述した内容を、別のブックのシートに一覧形式で入力していくマクロに変更するには どのようにマクロの記述をすれば宜しいのでしょうか?マクロの初心者にも分るようにご教授 いただければ助かります。よろしくお願いします。 Sub 入力() Dim LastRow As Long With Worksheets("sheet2") LastRow = Worksheets("sheet2").Range("B" & Rows.Count).End(xlUp).Row + 1 .Range("B" & LastRow).Value = Worksheets("sheet1").Range("B1").Value .Range("C" & LastRow).Value = Worksheets("sheet1").Range("B3").Value .Range("D" & LastRow).Value = Worksheets("sheet1").Range("B5").Value .Range("E" & LastRow).Value = Worksheets("sheet1").Range("B7").Value .Range("F" & LastRow).Value = Worksheets("sheet1").Range("B9").Value .Range("G" & LastRow).Value = Worksheets("sheet1").Range("B11").Value End With End Sub

  • VBA リストボックス(複数条件)で検索⇒転記方法

    VBA初心者です。 入門書を読み、コンボボックスを用いる(一つの条件検索)で請求書ツール作成までできたのですが、画像のようにユーザーフォームに複数選択リストを設けると現在のコードですと、エラーになってしまいます。 つきましては、リストボックスで条件を複数選択可能にして、該当データを転記するといったことを行いたいです。大変恐縮ですが、コードをご教示お願い致します。 ↓参考に、現状のコードを下記致します。 (ユーザーフォームのコード) Private Sub btnExit_Click() Unload Me End Sub Private Sub UserForm_Initialize() Dim ListRange As Range Dim temp As Range Dim vYear As Long Dim i As Long With Worksheets("取引先一覧").Range("A1").CurrentRegion Set ListRange = .Resize(.Rows.Count - 1).Offset(1) End With For Each temp In ListRange cmbcompany.AddItem temp.Value Next vYear = Year(Date) cmbYear.AddItem vYear - 1 cmbYear.AddItem vYear cmbYear.AddItem vYear + 1 cmbYear.Value = vYear For i = 1 To 12 cmbMonth.AddItem i Next End Sub Private Sub btnMakeBill_Click() MakeBill cmbcompany.Text, cmbYear.Text, cmbMonth.Text End Sub (標準モジュールのコード) Option Explicit Sub Main() frmMakeBill.Show End Sub Sub MakeBill(ByVal vCompany As String, ByVal vYear As Long, ByVal vMonth As Long) Dim TargetSheet As Worksheet Dim vDate As Date Dim DataRange As Range Dim TargetRange As Range Dim BillBook As Workbook Dim i As Long, vRow As Long Dim vInfo(1 To 2) As String On Error Resume Next Worksheets("請求書Template").Copy After:=Worksheets(Worksheets.Count) If Err.Number <> 0 Then MsgBox "「請求書Template」ワークシートが見つかりません。確認下ください" Exit Sub End If On Error GoTo 0 On Error GoTo ErrHdl Set TargetSheet = Worksheets(Worksheets.Count) Set TargetRange = TargetSheet.Range("A18") i = 1 vRow = 1 With Worksheets("受注データ").Range("A9") Do Until .Cells(i, 1).Value = "" vDate = .Cells(i, 1).Value If .Cells(i, 2).Value = vCompany _ And Year(vDate) = vYear And Month(vDate) = vMonth Then TargetRange.Cells(vRow, 1).Value = .Cells(i, 1).Value '「日付」列 TargetRange.Cells(vRow, 2).Value = .Cells(i, 3).Value '「商品コード」列 TargetRange.Cells(vRow, 3).Value = .Cells(i, 4).Value '「商品名」列 TargetRange.Cells(vRow, 4).Value = .Cells(i, 5).Value '「数量」列 TargetRange.Cells(vRow, 5).Value = .Cells(i, 6).Value '「単価」列 TargetRange.Cells(vRow, 6).Value = .Cells(i, 7).Value '「金額」列 vRow = vRow + 1 End If i = i + 1 Loop TargetSheet.Range("F28").Formula = "=SUM(F18:F27)" '「小計」 TargetSheet.Range("F29").Formula = "=F28 * 0.08" '「消費税額」 TargetSheet.Range("F30").Formula = "=F28 + F29" '「合計金額」 TargetSheet.Range("B6").Formula = "F30" '請求額 vInfo(1) = Date vInfo(2) = vCompany TargetSheet.Range("F2").Value = vInfo(1) '「請求日」 TargetSheet.Range("A6").Value = vInfo(2) '「請求先」 End With Set BillBook = Workbooks.Add TargetSheet.Cells.Copy BillBook.Worksheets(1).Range("A1") Application.DisplayAlerts = False TargetSheet.Delete Application.DisplayAlerts = True Exit Sub ErrHdl: MsgBox "エラーが発生しました。処理を終了します" End Sub

専門家に質問してみよう