Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

40087 / 76738

←次へ　｜　前へ→


	【41755】引数を使いコードをまとめたい

yusuke - 06/8/22(火) 1:55 -


	引用なし

	パスワード

知恵を貸してください。
標準モジュールに下記データが書き込まれているのですが
コードを引数を使いコンパクトにまとめる方法をご教授下さい。
よろしくお願いします。

Sub Main()
　　Dim Rtn As String
　　Dim X As Long

　　Rtn = InputBox("１から８０のいずれかを入力してください")
　　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

0 hits

▼

【41755】引数を使いコードをまとめたい yusuke 06/8/22(火) 1:55

≪