[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『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
(初心者じじい) 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
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
以前は、シートのコピー後、編集してましたが、恥ずかしくて誰にも見せませんでした。(笑)
まだまだ、改善の余地ありですが、タイトル変更だけで、(例えば ○○週報など)他にも利用出来そうです。サンプルコードを読み大変勉強になりました。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.