fork download
copy 
  1. Option Explicit
  2. Const mode_add As Long = 1    '登録
  3. Const mode_chg As Long = 2    '変更
  4. Const mode_del As Long = 3    '削除
  5. Const mode_find As Long = 4   '検索
  6. Dim ws As Worksheet     '接点記録シート
  7. Dim LastRow As Long     '最終行
  8. Dim execRow As Long     '実行行
  9. Dim execMode As Long    '実行モード
  10.  
  11. Private Sub UserForm_Initialize()
  12.     Me.ComboBox1.AddItem ("comb1")
  13.     Me.ComboBox1.AddItem ("comb2")
  14.     Me.ComboBox1.AddItem ("comb3")
  15.     Me.ComboBox1.AddItem ("comb4")
  16.     Set ws = Worksheets("接点記録")
  17.     Call disable_exec_Button
  18. End Sub
  19. Private Sub CommandButton登録_Click()
  20.     Call find_number(mode_add)
  21. End Sub
  22. Private Sub CommandButton変更_Click()
  23.     Call find_number(mode_chg)
  24. End Sub
  25. Private Sub CommandButton削除_Click()
  26.     Call find_number(mode_del)
  27. End Sub
  28. Private Sub CommandButton検索_Click()
  29.     Call find_number(mode_find)
  30. End Sub
  31.  
  32. '登録、変更、削除、検索共通処理
  33. Private Sub find_number(ByVal mode As Long)
  34.     Dim re As Object
  35.     Dim wrow As Long
  36.     Dim flag As Boolean
  37.     Dim i As Long
  38.     Set re = CreateObject("VBScript.RegExp")
  39.     re.Pattern = "^\d{8}$"
  40.     If re.test(Me.TextBox1.Text) = False Then
  41.         MsgBox ("入力エラー")
  42.         Exit Sub
  43.     End If
  44.     execMode = mode
  45.     '最終行検出
  46.     flag = False
  47.     LastRow = ws.Cells(rows.Count, "B").End(xlUp).Row
  48.     For wrow = 2 To LastRow
  49.         If Me.TextBox1.Text = ws.Cells(wrow, "B").Value Then
  50.             flag = True
  51.             execRow = wrow
  52.             Exit For
  53.         End If
  54.     Next
  55.     '該当番号なしのケース
  56.     If flag = False Then
  57.         If execMode <> mode_add Then
  58.             MsgBox ("該当番号なし")
  59.             Exit Sub
  60.         End If
  61.         '登録処理
  62.         'データ部クリア
  63.         Call clear_data
  64.         Call disable_menu_Button
  65.         Call enable_hozon_Button
  66.         Exit Sub
  67.     End If
  68.     '該当番号ありのケース
  69.     If execMode = mode_add Then
  70.         MsgBox ("該当番号登録済み")
  71.         Exit Sub
  72.     End If
  73.     'テキストボックスへ表示
  74.     Call load_data(wrow)
  75.     '検索の場合、終了
  76.     If execMode = mode_find Then Exit Sub
  77.     '変更の場合
  78.     If execMode = mode_chg Then
  79.         Call disable_menu_Button
  80.         Call enable_hozon_Button
  81.     End If
  82.     '削除の場合
  83.     If execMode = mode_del Then
  84.         Call disable_menu_Button
  85.         Call enable_delete_Button
  86.     End If
  87. End Sub
  88. Private Sub CommandButton保存_Click()
  89.     Dim wrow As Long
  90.     If execMode = mode_add Then
  91.         wrow = LastRow + 1
  92.     Else
  93.         wrow = execRow
  94.     End If
  95.     ws.Cells(wrow, "B").Value = Me.TextBox1.Text      '番号
  96.     ws.Cells(wrow, "C").Value = Me.TextBox2.Text      '氏名
  97.     ws.Cells(wrow, "D").Value = Me.TextBox3.Text      '住所
  98.     ws.Cells(wrow, "E").Value = Me.TextBox4.Text      '訪問日
  99.     ws.Cells(wrow, "F").Value = Me.ComboBox1.Text     '見積
  100.     ws.Cells(wrow, "G").Value = Me.TextBox5.Text      '担当者
  101.     ws.Cells(wrow, "H").Value = Me.TextBox6.Text      '内容
  102.     ws.Cells(wrow, "I").Value = Me.TextBox7.Text      '成約日
  103.     ws.Cells(wrow, "J").Value = Me.TextBox8.Text      '金額
  104.     ws.Cells(wrow, "K").Value = Me.TextBox9.Text      '備考
  105.     MsgBox ("保存完了")
  106.     Call clear_all_data    '全項目をクリア
  107.     Call enable_menu_Button
  108.     Call disable_exec_Button
  109. End Sub
  110. Private Sub CommandButton削除実行_Click()
  111.     ws.rows(execRow).Delete
  112.     MsgBox ("削除完了")
  113.     Call clear_all_data    '全項目をクリア
  114.     Call enable_menu_Button
  115.     Call disable_exec_Button
  116. End Sub
  117.  
  118. Private Sub CommandButton中止_Click()
  119.     Call clear_all_data    '全項目をクリア
  120.     Call enable_menu_Button
  121.     Call disable_exec_Button
  122. End Sub
  123.  
  124. Private Sub CommandButton閉じる_Click()
  125.     Unload Me
  126. End Sub
  127. '全項目クリア
  128. Private Sub clear_all_data()
  129.         Me.TextBox1.Value = ""
  130.         Call clear_data
  131. End Sub
  132. 'データ部クリア
  133. Private Sub clear_data()
  134.         Me.TextBox2.Value = ""
  135.         Me.TextBox3.Value = ""
  136.         Me.TextBox4.Value = ""
  137.         Me.ComboBox1.Value = ""
  138.         Me.TextBox5.Value = ""
  139.         Me.TextBox6.Value = ""
  140.         Me.TextBox7.Value = ""
  141.         Me.TextBox8.Value = ""
  142.         Me.TextBox9.Value = ""
  143. End Sub
  144. 'データ部設定
  145. Private Sub load_data(ByVal wrow As Long)
  146.     Me.TextBox2.Value = ws.Cells(wrow, "C").Value     '氏名
  147.     Me.TextBox3.Value = ws.Cells(wrow, "D").Value     '住所
  148.     Me.TextBox4.Value = ws.Cells(wrow, "E").Value     '訪問日
  149.     Me.ComboBox1.Value = ws.Cells(wrow, "F").Value    '見積
  150.     Me.TextBox5.Value = ws.Cells(wrow, "G").Value     '担当者
  151.     Me.TextBox6.Value = ws.Cells(wrow, "H").Value     '内容
  152.     Me.TextBox7.Value = ws.Cells(wrow, "I").Value     '成約日
  153.     Me.TextBox8.Value = ws.Cells(wrow, "J").Value     '金額
  154.     Me.TextBox9.Value = ws.Cells(wrow, "K").Value    '備考
  155. End Sub
  156.  
  157. Private Sub disable_menu_Button()
  158.     Me.CommandButton登録.Enabled = False
  159.     Me.CommandButton変更.Enabled = False
  160.     Me.CommandButton削除.Enabled = False
  161.     Me.CommandButton検索.Enabled = False
  162.     Me.TextBox1.Enabled = False
  163. End Sub
  164. Private Sub enable_menu_Button()
  165.     Me.CommandButton登録.Enabled = True
  166.     Me.CommandButton変更.Enabled = True
  167.     Me.CommandButton削除.Enabled = True
  168.     Me.CommandButton検索.Enabled = True
  169.     Me.TextBox1.Enabled = True
  170. End Sub
  171. Private Sub disable_exec_Button()
  172.     Me.CommandButton保存.Enabled = False
  173.     Me.CommandButton中止.Enabled = False
  174.     Me.CommandButton削除実行.Enabled = False
  175. End Sub
  176. Private Sub enable_hozon_Button()
  177.     Me.CommandButton保存.Enabled = True
  178.     Me.CommandButton中止.Enabled = True
  179. End Sub
  180. Private Sub enable_delete_Button()
  181.     Me.CommandButton中止.Enabled = True
  182.     Me.CommandButton削除実行.Enabled = True
  183. End Sub
  184.  
  185.  
Not running #stdin #stdout 0s 0KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Standard output is empty
https://ideone.com/9qF2Ze
language:
Text (text 6.10)
created:
184 days ago
visibility:
secret

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!