[[20140712211337]] 『Application.InputBoxでキャンセルされたら、Exce』(初心者じじい) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『Application.InputBoxでキャンセルされたら、Excel終了したい。』(初心者じじい)

Application.InputBox("",,,,,,1)で数値入力を求めてますが、
キャンセルをクリックされた場合、Excel終了したいのですが、コードをどう書いたらいいのか全く分かりません。
現状を全て書きます。実行して多々ある悪いところを修正頂けたら幸いです。
[営繕予定表]任意の月、一か月分。A4横、5頁。手書き用の用紙作成コードです。
祭日表sheetが非表示。フッター右に月が入ります。よろしくお願いします。

Private Sub workbook_open()

' 営繕予定表 Macro
'

'

    Dim tuki As String
    Dim mymsg As Integer

    mymsg = MsgBox("【営繕予定表】の希望月、一か月分を作成します。" & vbCrLf & " " & vbCrLf & _
        "表示される質問にしたがい入力して下さい。" & vbCrLf & " " & vbCrLf & _
           "開始しますか?", vbOKCancel + vbExclamation, "        << お知らせ >>")
On Error Resume Next
If Err.Number = 1004 Then
MsgBox "sheet1 シート名が重複します"
End If

    If mymsg = 1 Then
        Application.PrintCommunication = False
        With ActiveSheet.PageSetup
            .PrintTitleRows = ""
            .PrintTitleColumns = ""
        End With
        Application.PrintCommunication = True
        ActiveSheet.PageSetup.PrintArea = ""
        Application.PrintCommunication = False
        With ActiveSheet.PageSetup
            .LeftHeader = "社会福祉法人ふれあいコープ" & Chr(10) & "特別養護老人ホームみどり"
            .CenterHeader = ""
            .RightHeader = ""
            .LeftFooter = ""
            .CenterFooter = ""
            .RightFooter = ""
            .LeftMargin = Application.InchesToPoints(0.708661417322835)
            .RightMargin = Application.InchesToPoints(0.708661417322835)
            .TopMargin = Application.InchesToPoints(0.748031496062992)
            .BottomMargin = Application.InchesToPoints(0.748031496062992)
            .HeaderMargin = Application.InchesToPoints(0.31496062992126)
            .FooterMargin = Application.InchesToPoints(0.31496062992126)
            .PrintHeadings = False
            .PrintGridlines = False
            .PrintComments = xlPrintNoComments
            .PrintQuality = 600
            .CenterHorizontally = True
            .CenterVertically = False
            .Orientation = xlLandscape
            .Draft = False
            .PaperSize = xlPaperA4
            .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
        Application.PrintCommunication = False
        With ActiveSheet.PageSetup
            .PrintTitleRows = "$1:$6"
            .PrintTitleColumns = ""
        End With
        Application.PrintCommunication = True
        ActiveSheet.PageSetup.PrintArea = ""
        Application.PrintCommunication = False
        With ActiveSheet.PageSetup
            .LeftHeader = "社会福祉法人ふれあいコープ" & Chr(10) & "特別養護老人ホームみどり"
            .CenterHeader = ""
            .RightHeader = ""
            .LeftFooter = ""
            .CenterFooter = ""
            .RightFooter = ""
            .LeftMargin = Application.InchesToPoints(0.708661417322835)
            .RightMargin = Application.InchesToPoints(0.708661417322835)
            .TopMargin = Application.InchesToPoints(0.748031496062992)
            .BottomMargin = Application.InchesToPoints(0.748031496062992)
            .HeaderMargin = Application.InchesToPoints(0.31496062992126)
            .FooterMargin = Application.InchesToPoints(0.31496062992126)
            .PrintHeadings = False
            .PrintGridlines = False
            .PrintComments = xlPrintNoComments
            .PrintQuality = 600
            .CenterHorizontally = True
            .CenterVertically = False
            .Orientation = xlLandscape
            .Draft = False
            .PaperSize = xlPaperA4
            .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

        Columns("A:A").Select
        Selection.ColumnWidth = 10.29
        Columns("B:B").Select
        Selection.ColumnWidth = 3.29
        Columns("C:C").Select
        Selection.ColumnWidth = 3.43
        Columns("D:D").Select
        Selection.ColumnWidth = 25.29
        Columns("E:O").Select
        Selection.ColumnWidth = 6
        Columns("P:P").Select
        Selection.ColumnWidth = 9.14
        Columns("Q:Q").Select
        Selection.ColumnWidth = 9.29
        Rows("1:1").Select
        Selection.RowHeight = 21
        Rows("2:2").Select
        Selection.RowHeight = 13.5
        Rows("3:4").Select
        Selection.RowHeight = 27
        Rows("5:6").Select
        Selection.RowHeight = 13.5
        Rows("7:41").Select
        Selection.RowHeight = 55
        Range("A3:B4").Select
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlMedium
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlMedium
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlMedium
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlMedium
        End With
        Selection.Borders(xlInsideVertical).LineStyle = xlNone
        With Selection.Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        Range("D3:Q4").Select
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        Selection.Borders(xlInsideVertical).LineStyle = xlNone
        Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
        Range("D3:D4").Select
        Selection.NumberFormatLocal = "G/標準""月の予定"""
        With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = True
        End With
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        Selection.Borders(xlInsideVertical).LineStyle = xlNone
        Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
        Range("E3:Q4").Select
        Selection.Merge
        Range("A1").Select

        Range("A6:Q41").Select
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        Selection.Borders(xlInsideVertical).LineStyle = xlNone
        With Selection.Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With

        Range("B6:B41").Select
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        Selection.Borders(xlInsideVertical).LineStyle = xlNone
        With Selection.Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With

        Range("P6:P41").Select
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        Selection.Borders(xlInsideVertical).LineStyle = xlNone
        With Selection.Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        Range("C6").Select
        ActiveWindow.SmallScroll Down:=39
        Range("C6:D41").Select
        Selection.Merge True
        With Selection
            .HorizontalAlignment = xlLeft
            .VerticalAlignment = xlTop
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
        End With
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        Selection.Borders(xlInsideVertical).LineStyle = xlNone
        With Selection.Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        Range("A6:Q6").Select
        With Selection
            .HorizontalAlignment = xlCenter
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
        End With

        Range("B7:B41").Select
        With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
        End With
        Range("F6:N6").Select
        Selection.Borders(xlDiagonalDown).LineStyle = xlNone
        Selection.Borders(xlDiagonalUp).LineStyle = xlNone
        With Selection.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        With Selection.Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlThin
        End With
        Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
        Range("B1:Q1").Select
        Selection.Merge True
        With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = False
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = True
        End With
        ActiveCell.FormulaR1C1 = "営繕予定表"
        Range("B1:Q1").Select
        With Selection.Font
            .Name = "MS Pゴシック"
            .Size = 18
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ThemeColor = xlThemeColorLight1
            .TintAndShade = 0
            .ThemeFont = xlThemeFontNone
        End With
        Range("A6").Select
        ActiveCell.FormulaR1C1 = "月 日"
        Range("B6").Select
        ActiveCell.FormulaR1C1 = "曜日"
        Range("C6:D6").Select
        ActiveCell.FormulaR1C1 = "予   定"
        Range("E6").Select
        ActiveCell.FormulaR1C1 = "8時"
        Range("F6").Select
        ActiveCell.FormulaR1C1 = "9時"
        Range("G6").Select
        ActiveCell.FormulaR1C1 = "10時"
        Range("H6").Select
        ActiveCell.FormulaR1C1 = "11時"
        Range("I6").Select
        ActiveCell.FormulaR1C1 = "12時"
        Range("J6").Select
        ActiveCell.FormulaR1C1 = "13時"
        Range("K6").Select
        ActiveCell.FormulaR1C1 = "14時"
        Range("L6").Select
        ActiveCell.FormulaR1C1 = "15時"
        Range("M6").Select
        ActiveCell.FormulaR1C1 = "16時"
        Range("N6").Select
        ActiveCell.FormulaR1C1 = "17時"
        Range("O6").Select
        ActiveCell.FormulaR1C1 = "18時"
        Range("P6").Select
        ActiveCell.FormulaR1C1 = "印"
        Range("Q6").Select
        ActiveCell.FormulaR1C1 = "検印"
        Range("A6:Q6").Select
            With Selection.Interior
                .Pattern = xlSolid
                .Color = 13434828
            End With

        Range("A3").Select
            ActiveCell.FormulaR1C1 = Application.InputBox("西暦年を半角数字で入力してください。" & vbCrLf & " " & vbCrLf & "例:2015年⇒ 2015", "作成する西暦年の入力", , , , , , 1)
                Selection.NumberFormatLocal = "0""年"""
                Selection.Font.Size = 14
        Range("A4").Select
            ActiveCell.FormulaR1C1 = Application.InputBox("月を半角数字で入力してください。" & vbCrLf & " " & vbCrLf & "例:10月⇒ 10", "作成する月の入力", , , , , , 1)
                Selection.NumberFormatLocal = "0""月"""
                Selection.Font.Size = 14
                Selection.Font.Bold = True
        Range("D3").Select
        Range("D3").Formula = "=A4"
            Selection.NumberFormatLocal = "0""月の予定"""
            Selection.Font.Size = 16
        Range("C5").Select
        Range("C5").Formula = "=Date(A3,A4,1)"
            Selection.NumberFormatLocal = """"""
        Range("A7").Select
        Range("A7").Formula = "=C5-weekday(C5)+2"
            Selection.NumberFormatLocal = "m""月""d""日"""
        Range("A8").Select
        Range("A8").Formula = "=A7+1"
            Selection.NumberFormatLocal = "m""月""d""日"""
        Range("A9").Select
        Range("A9").Formula = "=A8+1"
            Selection.NumberFormatLocal = "m""月""d""日"""
        Range("A10").Select
        Range("A10").Formula = "=A9+1"
            Selection.NumberFormatLocal = "m""月""d""日"""
        Range("A11").Select
        Range("A11").Formula = "=A10+1"
            Selection.NumberFormatLocal = "m""月""d""日"""
        Range("A12").Select
        Range("A12").Formula = "=A11+1"
            Selection.NumberFormatLocal = "m""月""d""日"""
        Range("A13").Select
        Range("A13").Formula = "=A12+1"
            Selection.NumberFormatLocal = "m""月""d""日"""
        Range("A14").Select
        Range("A14").Formula = "=A13+1"
            Selection.NumberFormatLocal = "m""月""d""日"""
        Range("A15").Select
        Range("A15").Formula = "=A14+1"
            Selection.NumberFormatLocal = "m""月""d""日"""
        Range("A16").Select
        Range("A16").Formula = "=A15+1"
            Selection.NumberFormatLocal = "m""月""d""日"""
        Range("A17").Select
        Range("A17").Formula = "=A16+1"
            Selection.NumberFormatLocal = "m""月""d""日"""
        Range("A18").Select
        Range("A18").Formula = "=A17+1"
            Selection.NumberFormatLocal = "m""月""d""日"""
        Range("A19").Select
        Range("A19").Formula = "=A18+1"
            Selection.NumberFormatLocal = "m""月""d""日"""
        Range("A20").Select
        Range("A20").Formula = "=A19+1"
            Selection.NumberFormatLocal = "m""月""d""日"""
        Range("A21").Select
        Range("A21").Formula = "=A20+1"
            Selection.NumberFormatLocal = "m""月""d""日"""
        Range("A22").Select
        Range("A22").Formula = "=A21+1"
            Selection.NumberFormatLocal = "m""月""d""日"""
        Range("A23").Select
        Range("A23").Formula = "=A22+1"
            Selection.NumberFormatLocal = "m""月""d""日"""
        Range("A24").Select
        Range("A24").Formula = "=A23+1"
            Selection.NumberFormatLocal = "m""月""d""日"""
        Range("A25").Select
        Range("A25").Formula = "=A24+1"
            Selection.NumberFormatLocal = "m""月""d""日"""
        Range("A26").Select
        Range("A26").Formula = "=A25+1"
            Selection.NumberFormatLocal = "m""月""d""日"""
        Range("A27").Select
        Range("A27").Formula = "=A26+1"
            Selection.NumberFormatLocal = "m""月""d""日"""
        Range("A28").Select
        Range("A28").Formula = "=A27+1"
            Selection.NumberFormatLocal = "m""月""d""日"""
        Range("A29").Select
        Range("A29").Formula = "=A28+1"
            Selection.NumberFormatLocal = "m""月""d""日"""
        Range("A30").Select
        Range("A30").Formula = "=A29+1"
            Selection.NumberFormatLocal = "m""月""d""日"""
        Range("A31").Select
        Range("A31").Formula = "=A30+1"
            Selection.NumberFormatLocal = "m""月""d""日"""
        Range("A32").Select
        Range("A32").Formula = "=A31+1"
            Selection.NumberFormatLocal = "m""月""d""日"""
        Range("A33").Select
        Range("A33").Formula = "=A32+1"
            Selection.NumberFormatLocal = "m""月""d""日"""
        Range("A34").Select
        Range("A34").Formula = "=A33+1"
            Selection.NumberFormatLocal = "m""月""d""日"""
        Range("A35").Select
        Range("A35").Formula = "=A34+1"
            Selection.NumberFormatLocal = "m""月""d""日"""
        Range("A36").Select
        Range("A36").Formula = "=A35+1"
            Selection.NumberFormatLocal = "m""月""d""日"""
        Range("A37").Select
        Range("A37").Formula = "=A36+1"
            Selection.NumberFormatLocal = "m""月""d""日"""
        Range("A38").Select
        Range("A38").Formula = "=A37+1"
            Selection.NumberFormatLocal = "m""月""d""日"""
        Range("A39").Select
        Range("A39").Formula = "=A38+1"
            Selection.NumberFormatLocal = "m""月""d""日"""
        Range("A40").Select
        Range("A40").Formula = "=A39+1"
            Selection.NumberFormatLocal = "m""月""d""日"""
        Range("A41").Select
        Range("A41").Formula = "=A40+1"
            Selection.NumberFormatLocal = "m""月""d""日"""

        Range("B7").Select
        Range("B7").Formula = "=A7"
            Selection.NumberFormatLocal = "aaa"
        Range("B8").Select
        Range("B8").Formula = "=A8"
            Selection.NumberFormatLocal = "aaa"
        Range("B9").Select
        Range("B9").Formula = "=A9"
            Selection.NumberFormatLocal = "aaa"
        Range("B10").Select
        Range("B10").Formula = "=A10"
            Selection.NumberFormatLocal = "aaa"
        Range("B11").Select
        Range("B11").Formula = "=A11"
            Selection.NumberFormatLocal = "aaa"
        Range("B12").Select
        Range("B12").Formula = "=A12"
            Selection.NumberFormatLocal = "aaa"
        Range("B13").Select
        Range("B13").Formula = "=A13"
            Selection.NumberFormatLocal = "aaa"
        Range("B14").Select
        Range("B14").Formula = "=A14"
            Selection.NumberFormatLocal = "aaa"
        Range("B15").Select
        Range("B15").Formula = "=A15"
            Selection.NumberFormatLocal = "aaa"
        Range("B16").Select
        Range("B16").Formula = "=A16"
            Selection.NumberFormatLocal = "aaa"
        Range("B17").Select
        Range("B17").Formula = "=A17"
            Selection.NumberFormatLocal = "aaa"
        Range("B18").Select
        Range("B18").Formula = "=A18"
            Selection.NumberFormatLocal = "aaa"
        Range("B19").Select
        Range("B19").Formula = "=A19"
            Selection.NumberFormatLocal = "aaa"
        Range("B20").Select
        Range("B20").Formula = "=A20"
            Selection.NumberFormatLocal = "aaa"
        Range("B21").Select
        Range("B21").Formula = "=A21"
            Selection.NumberFormatLocal = "aaa"
        Range("B22").Select
        Range("B22").Formula = "=A22"
            Selection.NumberFormatLocal = "aaa"
        Range("B23").Select
        Range("B23").Formula = "=A23"
            Selection.NumberFormatLocal = "aaa"
        Range("B24").Select
        Range("B24").Formula = "=A24"
            Selection.NumberFormatLocal = "aaa"
        Range("B25").Select
        Range("B25").Formula = "=A25"
            Selection.NumberFormatLocal = "aaa"
        Range("B26").Select
        Range("B26").Formula = "=A26"
            Selection.NumberFormatLocal = "aaa"
        Range("B27").Select
        Range("B27").Formula = "=A27"
            Selection.NumberFormatLocal = "aaa"
        Range("B28").Select
        Range("B28").Formula = "=A28"
            Selection.NumberFormatLocal = "aaa"
        Range("B29").Select
        Range("B29").Formula = "=A29"
            Selection.NumberFormatLocal = "aaa"
        Range("B30").Select
        Range("B30").Formula = "=A30"
            Selection.NumberFormatLocal = "aaa"
        Range("B31").Select
        Range("B31").Formula = "=A31"
            Selection.NumberFormatLocal = "aaa"
        Range("B32").Select
        Range("B32").Formula = "=A32"
            Selection.NumberFormatLocal = "aaa"
        Range("B33").Select
        Range("B33").Formula = "=A33"
            Selection.NumberFormatLocal = "aaa"
        Range("B34").Select
        Range("B34").Formula = "=A34"
            Selection.NumberFormatLocal = "aaa"
        Range("B35").Select
        Range("B35").Formula = "=A35"
            Selection.NumberFormatLocal = "aaa"
        Range("B36").Select
        Range("B36").Formula = "=A36"
            Selection.NumberFormatLocal = "aaa"
        Range("B37").Select
        Range("B37").Formula = "=A37"
            Selection.NumberFormatLocal = "aaa"
        Range("B38").Select
        Range("B38").Formula = "=A38"
            Selection.NumberFormatLocal = "aaa"
        Range("B39").Select
        Range("B39").Formula = "=A39"
            Selection.NumberFormatLocal = "aaa"
        Range("B40").Select
        Range("B40").Formula = "=A40"
            Selection.NumberFormatLocal = "aaa"
        Range("B41").Select
        Range("B41").Formula = "=A41"
            Selection.NumberFormatLocal = "aaa"

        Range("A7:Q41").Select
        Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=WEEKDAY($A7)=1"
        Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
        With Selection.FormatConditions(1).Interior
            .Pattern = xlGray50
            .PatternThemeColor = xlThemeColorDark1
            .ColorIndex = xlAutomatic
            .PatternTintAndShade = -0.14996795556505
        End With
        Selection.FormatConditions(1).StopIfTrue = False
        Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=WEEKDAY($A7)=4"
        Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
        With Selection.FormatConditions(1).Interior
            .Pattern = xlGray50
            .PatternThemeColor = xlThemeColorDark1
            .ColorIndex = xlAutomatic
            .PatternTintAndShade = -0.14996795556505
        End With
        Selection.FormatConditions(1).StopIfTrue = False
        Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
            "=WEEKDAY($A7)=7"
        Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
        With Selection.FormatConditions(1).Interior
            .Pattern = xlGray50
            .PatternThemeColor = xlThemeColorDark1
            .ColorIndex = xlAutomatic
            .PatternTintAndShade = -0.14996795556505
        End With
        Selection.FormatConditions(1).StopIfTrue = False

        ActiveSheet.Name = Range("A4").Value & "月"
        Range("C7:D7").Select
            ActiveCell.FormulaR1C1 = "=IFERROR(VLOOKUP(RC1,祭日表!R2C1:R89C2,2,FALSE),"""")"
            Range("C7:D7").Select
            Selection.AutoFill Destination:=Range("C7:D41"), Type:=xlFillDefault
            Range("C7:D41").Select
            Range("A1").Select

    Else
            Application.Quit
    End If
End Sub

Private Sub Workbook_BeforePrint(Cancel As Boolean)

    Dim mymsg As Integer

        mymsg = MsgBox("【営繕予定表】を印刷します。" & vbCrLf & " " & vbCrLf & _
        "ヘッダー右に [印刷日:(和暦)]、フッター右に [ファイル名]+[シート名] が印刷時に入ります。" & vbCrLf & " " & vbCrLf & _
           "自動実行しますか?", vbYesNo + vbExclamation, "        << お知らせ&確認 >>")

        If mymsg = 6 Then
            ActiveSheet.PageSetup.RightHeader = "&07 印刷日:" & Format(Date, "ggge年mm月dd日")
            ActiveSheet.PageSetup.RightFooter = "&07 &F  &A"
        Else
            ActiveSheet.PageSetup.RightHeader = ""
            ActiveSheet.PageSetup.RightFooter = ""
            MsgBox "ヘッダー右とフッター右への自動入力は" & vbCrLf & "取消されました。", vbOKOnly, "     <<自動入力の中止>>"
        End If
End Sub

< 使用 Excel:Excel2010、使用 OS:WindowsXP >


 ↓にキャンセルの場合の処理方法が記述されています。
 >InputBox関数
 と
 >ApplicationオブジェクトのInputBoxメソッド
 の両方について説明されています。

http://officetanaka.net/excel/vba/tips/tips37.htm
(カリーニン) 2014/07/12(土) 21:51


カリーニンさん、ありがとうございます。
http://officetanaka.net/excel/vba/tips/tips37.htm は何度も読みましたが、
やはり、うまく動いてくれません。
実際、私のコードを修正していただけたら幸せです。
(初心者じじい)


(初心者じじい) 2014/07/12(土) 22:07


 ↓の部分を置き換えたものがSub test()です。
 -----------------
  Range("A3").Select
  ActiveCell.FormulaR1C1 = Application.InputBox("西暦年を半角数字で入力してください。" & vbCrLf & " " & vbCrLf & "例:2015年⇒ 2015", "作成する西暦年の入力", , , , , , 1)
  Selection.NumberFormatLocal = "0""年"""
  Selection.Font.Size = 14
 ------------------

 Sub test()
  Dim myipt As Integer
   myipt = Application.InputBox("西暦年を半角数字で入力してください。" & vbCrLf & " " & vbCrLf & "例:2015年⇒ 2015", "作成する西暦年の入力", , , , , , 1)
   If myipt = False Then
      MsgBox "キャンセル"
   Else
      With ActiveSheet.Range("A3")
       .FormulaR1C1 = myipt
       .NumberFormatLocal = "0""年"""
       .Font.Size = 14
      End With
   End If
 End Sub

 あとは同じように書き換えるだけです。

 ※Select/Selectionを多用されていますのでコードの見直しの余地がたくさんあるように思われます。
 ↓などを参考に見直しされることをお勧めします。

 Office TANAKA - VBA高速化テクニック(Selectするな!)
http://officetanaka.net/excel/vba/speed/s2.htm
(カリーニン) 2014/07/12(土) 22:46

カリーニンさん ありがとうございます。

書換えし、試してみましたが、
Msg"キャンセル" 表示されるだけで、最終的には計算エラーになります。
Application.Quitを次の行に書き加えても、Excelは終了しません。
Excel終了にしたいのです。よろしくおねがいします。(初心者じじい)

(初心者じじい) 2014/07/12(土) 23:36


 >MsgBox "キャンセル"

 これをキャンセルした場合の実際のコードに置き換えるだけです。
 現状のコードをアップしてみてください。
(カリーニン) 2014/07/12(土) 23:52

カリーニンさん お手数掛けます。
部分でよろしいでしょうか?
二つのInputBoxがありますが、どちらもExcelは終了しません。
また、False を 0 や ””にしても改善されません。よろしくおねがいします。
(初心者じじい)

Dim myipt As Integer

   Range("A3").Select
          myipt = Application.InputBox("西暦年を半角数字で入力してください。" & vbCrLf & " " & vbCrLf & "例:2015年⇒ 2015", "作成する西暦年の入力", , , , , , 1)
                If myipt = False Then
                Application.Quit
                Else
                    With ActiveSheet.Range("A3")
                    .FormulaR1C1 = myipt
                    .NumberFormatLocal = "0""年"""
                    .Font.Size = 14
                    End With
                End If

        Range("A4").Select
           myipt = Application.InputBox("月を半角数字で入力してください。" & vbCrLf & " " & vbCrLf & "例:10月⇒ 10", "作成する月の入力", , , , , , 1)
                If myipt = False Then
                Application.Quit
                Else
                    With ActiveSheet.Range("A4")
                    .FormulaR1C1 = myipt
                    .NumberFormatLocal = "0""月"""
                    .Font.Size = 14
                    .Font.Bold = True
                    End With
                End If
(初心者じじい) 2014/07/13(日) 00:33

 サンプルコードです。

 変数型を変えてあります。

 Sub testA()
  Dim myiptA As Variant
  Dim myiptB As Variant
   flg = True
   myiptA = Application.InputBox("西暦年を半角数字で入力してください。" & vbCrLf & " " & vbCrLf & "例:2015年⇒ 2015", "作成する西暦年の入力", Type:=1)
   If TypeName(myiptA) = "Boolean" Then GoTo deguti
   myiptB = Application.InputBox("月を半角数字で入力してください。" & vbCrLf & " " & vbCrLf & "例:10月⇒ 10", "作成する月の入力", Type:=1)
   If TypeName(myiptB) = "Boolean" Then
      GoTo deguti
   Else
     If myiptB > 12 Or myiptB < 1 Then
        MsgBox "1-12以外が入力されました"
        GoTo deguti
      End If
   End If
   With ActiveSheet.Range("A3")
    .FormulaR1C1 = myiptA
    .NumberFormatLocal = "0""年"""
    .Font.Size = 14
   End With
   With ActiveSheet.Range("A4")
    .FormulaR1C1 = myiptB
    .NumberFormatLocal = "0""月"""
    .Font.Size = 14
    .Font.Bold = True
   End With
   Exit Sub
 deguti:
   ThisWorkbook.Saved = True
   If Workbooks.Count = 1 Then
      Application.Quit
    Else
      ThisWorkbook.Close
   End If
 End Sub

 Sub testB()
  Dim myiptA As Variant
  Dim myiptB As Variant
  Dim flg As Boolean
   flg = True
   myiptA = Application.InputBox("西暦年を半角数字で入力してください。" & vbCrLf & " " & vbCrLf & "例:2015年⇒ 2015", "作成する西暦年の入力", Type:=1)
   If myiptA = False Then
      flg = False
   End If
   myiptB = Application.InputBox("月を半角数字で入力してください。" & vbCrLf & " " & vbCrLf & "例:10月⇒ 10", "作成する月の入力", Type:=1)
   If myiptB = False Then
      flg = False
   Else
     If myiptB > 12 Or myiptB < 1 Then
        MsgBox "1-12以外が入力されました"
        flg = False
     End If
   End If
   If flg = False Then
      ThisWorkbook.Saved = True
      If Workbooks.Count = 1 Then
         Application.Quit
      Else
         ThisWorkbook.Close
      End If
   Else
      With ActiveSheet.Range("A3")
       .FormulaR1C1 = myiptA
       .NumberFormatLocal = "0""年"""
       .Font.Size = 14
      End With
      With ActiveSheet.Range("A4")
       .FormulaR1C1 = myiptB
       .NumberFormatLocal = "0""月"""
       .Font.Size = 14
       .Font.Bold = True
      End With
   End If
 End Sub
(カリーニン) 2014/07/13(日) 12:42

回答では有りませんが
施設名は「仮名か伏字」に変えたほうがよろしいかと。

(jun53) 2014/07/13(日) 18:21


カリーニンさん ありがとうございます。
testA() & testB() 早速、当てはめてみたら、両方とも快適に動作しました。

以前は、シートのコピー後、編集してましたが、恥ずかしくて誰にも見せませんでした。(笑)
まだまだ、改善の余地ありですが、タイトル変更だけで、(例えば ○○週報など)他にも利用出来そうです。サンプルコードを読み大変勉強になりました。Select,Selectionを省いて整理しました。ありがとうございます。

jun53 さん、ご指摘ありがとうございます。次回は、手抜きしないように心がけます。

余談:LeftFooterにGIFを入れたいのですが、現在うまくいってません。

(初心者じじい) 2014/07/13(日) 20:52


 >LeftFooterにGIFを入れたいのですが、現在うまくいってません。 

 参考HPです。
http://www.siminpc-kitakyushu.com/index.php?QBlog-20130909-1

 説明ではクリップアートになってますが、「ファイルから」で
 同じように操作できると思います。
(カリーニン) 2014/07/13(日) 21:44

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.