Results of 1 - 1 of about 1215 for （Mook）
(0.001 sec.)
- [[20150309155822]]
- #score: 9211
- @digest: 18a44c0d3ce507ac7e5177485b05b892
- @id: 67458
- @mdate: 2015-03-10T06:17:53Z
- @size: 11143
- @type: text/plain
- #keywords: 刷ws (67484), 刷日 (43485), inchestopoints (35166), evenpage (26430), firstpage (25921), printcommunication (24901), 刷位 (23885), タws (23812), タ設 (15560), 刷シ (15017), 刷済 (14495), xlpapera3 (12797), 数). (10887), 象日 (10871), 置= (10475), 印刷 (9734), タ列 (8672), 日as (8545), 定= (8363), 刷実 (7047), papersize (6769), pagesetup (6731), 日, (6308), 始日 (5709), 日= (5660), 刷用 (5483), 了日 (4268), 行, (4002), cdate (3999), 定. (3996), 数, (3790), タ行 (3759)
- 『その週のメンバー一覧を印刷したい』（kaoru）
毎月のシートが12ヵ月分あります。 表は1日1表で縦に一月10〜最大25日分程度の表が縦にならんでいます。 最初の行のB列に日付が入っており、その行を含めて1表30行です 日付を参照しながら1週間分のA列からE列を横に印刷したいのです。 可能であれば、今週、来週と指定できれば嬉しいのですが 可能でしょうか? 説明が下手ですいません。 ＜ 使用 Excel:Excel2010、使用 OS:Windows7 ＞ ---- 半角数字で1月〜12月のシートがあり、シートのB列の表の日付は 今年の日付がある前提です。 Sub Sample() Dim 開始日, 終了日, 印刷日 開始日 = CDate(InputBox("開始日を入力してください。", , Format(Date, "YYYY/MM/DD"))) 終了日 = CDate(InputBox("終了日を入力してください。", , Format(DateAdd("D", 6, 開始日), "YYYY/MM/DD"))) Dim 印刷シート As Worksheet Dim シート名 As String Dim 印刷済み As Boolean Dim 行 As Long For 印刷日 = 開始日 To 終了日 シート名 = Month(印刷日) & "月" On Error Resume Next Set 印刷シート = Worksheets(シート名) On Error GoTo 0 If 印刷シート Is Nothing Then If MsgBox("[" & シート名 & "] シートがありません。" & vbNewLine & "印刷を続けますか?", vbYesNo) = vbNo Then Exit Sub End If 印刷済み = False For 行 = 1 To 印刷シート.Cells(Rows.Count, "B").End(xlUp).Row If IsDate(Cells(行, "B").Value) = True Then If CDate(Cells(行, "B").Value) = 印刷日 Then With 印刷シート .PageSetup.PrintArea = Cells(行, "A").Resize(30, 5).AddressLocal '// 印刷範囲指定 .PageSetup.Orientation = xlLandscape '// 用紙方向指定 .PrintPreview '// 印刷（プレビュー）: 問題なければ .PrintPreview を .PrintOut に変更 End With 印刷済み = True Exit For End If End If Next If 印刷済み = False Then If MsgBox("[" & Format(印刷日, "YYYY/MM/DD") & "] の表がありません", vbYesNo) = vbNo Then Exit Sub End If Next End Sub マクロの印刷設定の調整は、下記が参考になるかと思います。 http://www.atmarkit.co.jp/ait/articles/1403/25/news038.html http://www.asahi-net.or.jp/‾zn3y-ngi/YNxv20011.html （Mook） 2015/03/09(月) 17:32 ---- Mookさん ありがとうございます。 マクロ、きちんと動いているようです。 しかし、ご想像の通り、残りは印刷設定です。 できればA4横1枚に全体を縮小して印刷したいのですが 教えて頂いたサイトを見なおして 何とか頑張ってみます。 （そもそも可能なのかなぁ…） 頑張りまーす （kaoru） 2015/03/10(火) 05:17 ---- Mookさん 途中経過ですが… .PageSetup.Zoom = 80 .PageSetup.PaperSize = xlPaperA3 などやってみましたが、 1週分を横に並べて1週を1ページにしたいのですが 1日分1ページが変更できません えぇーと… もう少し、解読してみます （kaoru） 2015/03/10(火) 06:25 ---- > できればA4横1枚に全体を縮小して印刷したいのですが 拡大率は縦横や1ページフィットなどもあるので、そのあたりが使えると思います。 > 1週分を横に並べて1週を1ページにしたいのですが やりたい操作は手動でやろうとした場合、どのような操作になるのでしょうか。 複数の表を横に並べてというと、現在のシート構成ではできないので、印刷用のシートを 用意して、そこにコピーしてから印刷というように、作業の変更が必要な気がします。 （Mook） 2015/03/10(火) 07:57 ---- Mookさん ながくなってしまいますが、4月6日の週を 「印刷用シート」に手動でコピーし、A3横で 横幅を紙幅に合わせて印刷した場合の物です Sub Macro1() Range("A62:C91").Select Selection.Copy Sheets("印刷用シート").Select ActiveSheet.Paste Sheets("4月").Select Range("A92:C121").Select Application.CutCopyMode = False Selection.Copy Sheets("印刷用シート").Select Range("D1").Select ActiveSheet.Paste Sheets("4月").Select Range("A122:C151").Select Application.CutCopyMode = False Selection.Copy Sheets("印刷用シート").Select Range("G1").Select ActiveSheet.Paste Sheets("4月").Select Range("A152:C211").Select Application.CutCopyMode = False Selection.Copy Sheets("印刷用シート").Select Range("J1").Select ActiveSheet.Paste Application.CutCopyMode = False Application.PrintCommunication = False With ActiveSheet.PageSetup .PrintTitleRows = "" .PrintTitleColumns = "" End With Application.PrintCommunication = True ActiveSheet.PageSetup.PrintArea = "" Application.PrintCommunication = False With ActiveSheet.PageSetup .LeftHeader = "" .CenterHeader = "" .RightHeader = "" .LeftFooter = "" .CenterFooter = "" .RightFooter = "" .LeftMargin = Application.InchesToPoints(0.7) .RightMargin = Application.InchesToPoints(0.7) .TopMargin = Application.InchesToPoints(0.75) .BottomMargin = Application.InchesToPoints(0.75) .HeaderMargin = Application.InchesToPoints(0.3) .FooterMargin = Application.InchesToPoints(0.3) .PrintHeadings = False .PrintGridlines = False .PrintComments = xlPrintNoComments .CenterHorizontally = False .CenterVertically = False .Orientation = xlLandscape .Draft = False .PaperSize = xlPaperA3 .FirstPageNumber = xlAutomatic .Order = xlDownThenOver .BlackAndWhite = False .Zoom = 100 .PrintErrors = xlPrintErrorsDisplayed .OddAndEvenPagesHeaderFooter = False .DifferentFirstPageHeaderFooter = False .ScaleWithDocHeaderFooter = True .AlignMarginsHeaderFooter = True .EvenPage.LeftHeader.Text = "" .EvenPage.CenterHeader.Text = "" .EvenPage.RightHeader.Text = "" .EvenPage.LeftFooter.Text = "" .EvenPage.CenterFooter.Text = "" .EvenPage.RightFooter.Text = "" .FirstPage.LeftHeader.Text = "" .FirstPage.CenterHeader.Text = "" .FirstPage.RightHeader.Text = "" .FirstPage.LeftFooter.Text = "" .FirstPage.CenterFooter.Text = "" .FirstPage.RightFooter.Text = "" End With Application.PrintCommunication = True ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _ IgnorePrintAreas:=False End Sub よろしくお願いします。 （kaoru） 2015/03/10(火) 13:21 ---- まぁわかるといえばわかるのですが、言葉でも説明が欲しいでしょうか。 一週間といっていますが、マクロは4日分のようなので、そこはコード上は定数にしました。 一応のサンプルですので、細かい調整は試行錯誤してみてください。 大丈夫とは思いますが、標準モジュールに置く前提です。 Option Explicit '//------------------------------------------ Const 印刷シート名 = "印刷シート" '//【設定】 Const 印刷日数 = 6 '//【設定】 印刷シートのデータ数 '//------------------------------------------ Const データ列数 = 3 '//【設定】 Const データ行数 = 30 '//【設定】 '//------------------------------------------ Sub 期間印刷() '//------------------------------------------ Dim 開始日 As Date 開始日 = CDate(InputBox("開始日を入力してください。", , Format(Date + ((9 - Weekday(Date)) Mod 7), "YYYY/MM/DD"))) Dim 終了日 As Date 終了日 = CDate(Format(DateAdd("D", 印刷日数 - 1, 開始日), "YYYY/MM/DD")) If MsgBox(Format(開始日, "YYYY/MM/DD(aaa)") & "〜" & Format(終了日, "YYYY/MM/DD(aaa)") & " を印刷しますか?", vbYesNo) = vbNo Then Exit Sub Dim 印刷日 As Date Dim 位置 As Long 位置 = 1 For 印刷日 = 開始日 To 終了日 If データ設定(印刷日, 位置) = False Then Exit Sub Next If 位置 = 1 Then MsgBox "印刷するデータがありません" Exit Sub End If 印刷実行 End Sub '//------------------------------------------ Function データ設定(対象日 As Date, ByRef 印刷位置 As Long) As Boolean '//------------------------------------------ '// 印刷開始位置は A1 を決め打ち '//------------------------------------------ Dim データシート名 As String Dim データWS As Worksheet Dim 印刷WS As Worksheet Set 印刷WS = Worksheets(印刷シート名) データシート名 = Month(対象日) & "月" On Error Resume Next Set データWS = Worksheets(データシート名) On Error GoTo 0 If データWS Is Nothing Then If MsgBox("[" & データシート名 & "] シートがありません。" & vbNewLine & "印刷を続けますか?", vbYesNo) = vbNo Then データ設定 = False Else データ設定 = True End If Exit Function End If Dim 行 As Long For 行 = 1 To データWS.Cells(Rows.Count, "B").End(xlUp).Row If IsDate(データWS.Cells(行, "B").Value) = True Then If CDate(データWS.Cells(行, "B").Value) = 対象日 Then If 印刷位置 = 1 Then 印刷WS.Range("A1").Resize(データ行数, データ列数 * 印刷日数).ClearContents End If データWS.Cells(行, "A").Resize(データ行数, データ列数).Copy 印刷WS.Range("A1").Offset(0, (印刷位置 - 1) * データ列数).Resize(データ行数, データ列数) 印刷位置 = 印刷位置 + 1 データ設定 = True Exit Function End If End If Next If MsgBox("[" & Format(対象日, "YYYY/MM/DD(aaa)") & "] の表がありません" & vbNewLine & "印刷を続けますか?", vbYesNo, vbYesNo) = vbNo Then データ設定 = False Else データ設定 = True End If End Function '//------------------------------------------ Private Sub 印刷実行() '//------------------------------------------ Const 等倍印刷 = False '//【設定】True ・・・ 等倍 / False ・・・ 1ページ印刷 Dim 印刷WS As Worksheet Set 印刷WS = Worksheets(印刷シート名) '// 印刷設定 Application.PrintCommunication = False '// EXCEL 2010 以降のみ With 印刷WS.PageSetup .PrintArea = Range("A1").Resize(データ行数, データ列数 * 印刷日数).AddressLocal .LeftMargin = Application.InchesToPoints(0.7) .RightMargin = Application.InchesToPoints(0.7) .TopMargin = Application.InchesToPoints(0.75) .BottomMargin = Application.InchesToPoints(0.75) .HeaderMargin = Application.InchesToPoints(0.3) .FooterMargin = Application.InchesToPoints(0.3) .PrintComments = xlPrintNoComments .Orientation = xlLandscape '// 印刷用紙 横指定 .PaperSize = xlPaperA3 '// A3 ? If 等倍印刷 = True Then .Zoom = 100 Else '// 全体を1ページに印刷 .FitToPagesTall = 1 .FitToPagesWide = 1 End If .PrintErrors = xlPrintErrorsDisplayed .ScaleWithDocHeaderFooter = True .AlignMarginsHeaderFooter = True End With Application.PrintCommunication = True 印刷WS.PrintPreview ' 印刷WS.PrintOut Copies:=1 '// 印刷実行 End Sub （Mook） 2015/03/10(火) 15:17... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/201503/20150309155822.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97054 documents and 608267 words.
訪問者：