Excel VBA質問箱 IV

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

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


40081 / 76732 ←次へ | 前へ→

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

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

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

0 hits

【41755】引数を使いコードをまとめたい yusuke 06/8/22(火) 1:55 質問
【41756】Re:引数を使いコードをまとめたい Blue 06/8/22(火) 2:16 発言
【41757】Re:引数を使いコードをまとめたい Kein 06/8/22(火) 2:48 回答
【41762】Re:引数を使いコードをまとめたい yusuke 06/8/22(火) 9:44 発言
【41763】Re:引数を使いコードをまとめたい ponpon 06/8/22(火) 10:56 発言
【41764】Re:引数を使いコードをまとめたい yusuke 06/8/22(火) 11:42 発言
【41765】Re:引数を使いコードをまとめたい ponpon 06/8/22(火) 12:02 発言
【41770】Re:引数を使いコードをまとめたい yusuke 06/8/22(火) 13:27 発言
【41778】Re:引数を使いコードをまとめたい Kein 06/8/22(火) 16:22 発言
【41786】Re:引数を使いコードをまとめたい yusuke 06/8/22(火) 19:05 お礼

40081 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free