|
知恵を貸してください。
標準モジュールに下記データが書き込まれているのですが
コードを引数を使いコンパクトにまとめる方法をご教授下さい。
よろしくお願いします。
Sub Main()
Dim Rtn As String
Dim X As Long
Rtn = InputBox("1から80のいずれかを入力してください")
X = Val(Rtn)
Select Case X
Case 1
Call Code01
Case 2
Call Code02
Case 3
Call Code03
Case 4
Call Code04
・
・
・
Case 80
Call Code80
End Select
End Sub
---------------------------------------------------------------------------
Sub Code01()
Dim rc As Long
rc = MsgBox(Sheets("入力").Range("B8").Value & "の契約書作成します。", vbYesNo)
If rc = vbYes Then
rc = MsgBox("内訳は、" & Sheets("入力").Range("J8").Value & "です。", vbYesNo)
If rc = vbYes Then
Sheets("入力").Select
Range("A8:BC8").Select
Selection.Copy
Sheets("契約書作成").Select
Range("AN3").Select
ActiveSheet.Paste
Sheets("入力").Select
Application.CutCopyMode = False
Range("A7").Select
Sheets("契約書作成").Select
With Selection.Interior
Range("AM3:DA3").Select
.ColorIndex = 10
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Application.Goto Reference:="R1C1"
End If
End If
End Sub
Sub Code02()
Dim rc As Long
rc = MsgBox(Sheets("入力").Range("B9").Value & "の契約書作成します。", vbYesNo)
If rc = vbYes Then
rc = MsgBox("内訳は、" & Sheets("入力").Range("J9").Value & "です。", vbYesNo)
If rc = vbYes Then
Sheets("入力").Select
ActiveWindow.SmallScroll ToRight:=-7
Range("A9:BC9").Select
Selection.Copy
Sheets("契約書作成").Select
Range("AN3").Select
ActiveSheet.Paste
Sheets("入力").Select
Application.CutCopyMode = False
Range("A7").Select
Sheets("契約書作成").Select
Range("AM3:DA3").Select
With Selection.Interior
.ColorIndex = 10
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Application.Goto Reference:="R1C1"
End If
End If
End Sub
Sub Code03()
Dim rc As Long
rc = MsgBox(Sheets("入力").Range("B10").Value & "の契約書作成します。", vbYesNo)
If rc = vbYes Then
rc = MsgBox("内訳は、" & Sheets("入力").Range("J10").Value & "です。", vbYesNo)
If rc = vbYes Then
Sheets("入力").Select
ActiveWindow.SmallScroll ToRight:=-7
Range("A10:BC10").Select
Selection.Copy
Sheets("契約書作成").Select
Range("AN3").Select
ActiveSheet.Paste
Sheets("入力").Select
Application.CutCopyMode = False
Range("A7").Select
Sheets("契約書作成").Select
Range("AM3:DA3").Select
With Selection.Interior
.ColorIndex = 10
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Application.Goto Reference:="R1C1"
End If
End If
End Sub
・
・
・
Sub Code80()
Dim rc As Long
rc = MsgBox(Sheets("入力").Range("B87").Value & "の契約書作成します。", vbYesNo)
If rc = vbYes Then
rc = MsgBox("内訳は、" & Sheets("入力").Range("J87").Value & "です。", vbYesNo)
If rc = vbYes Then
Sheets("入力").Select
ActiveWindow.SmallScroll ToRight:=-7
Range("A87:BC87").Select
Selection.Copy
Sheets("契約書作成").Select
Range("AN3").Select
ActiveSheet.Paste
Sheets("入力").Select
Application.CutCopyMode = False
Range("A7").Select
Sheets("契約書作成").Select
Range("AM3:DA3").Select
With Selection.Interior
.ColorIndex = 10
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Application.Goto Reference:="R1C1"
End If
End If
End Sub
|
|