fork download 
  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 LastRow As Long     '最終行
  7. Dim execRow As Long     '実行行
  8. Dim execMode As Long    '実行モード
  9.  
  10. Private Sub UserForm_Initialize()
  11.     Me.ComboBox1.AddItem ("comb1")
  12.     Me.ComboBox1.AddItem ("comb2")
  13.     Me.ComboBox1.AddItem ("comb3")
  14.     Me.ComboBox1.AddItem ("comb4")
  15.     Call disable_exec_Button
  16. End Sub
  17. Private Sub CommandButton登録_Click()
  18.     Call find_number(mode_add)
  19. End Sub
  20. Private Sub CommandButton変更_Click()
  21.     Call find_number(mode_chg)
  22. End Sub
  23. Private Sub CommandButton削除_Click()
  24.     Call find_number(mode_del)
  25. End Sub
  26. Private Sub CommandButton検索_Click()
  27.     Call find_number(mode_find)
  28. End Sub
  29.  
  30. '登録、変更、削除、検索共通処理
  31. Private Sub find_number(ByVal mode As Long)
  32.     Dim re As Object
  33.     Dim wrow As Long
  34.     Dim flag As Boolean
  35.     Dim i As Long
  36.     Dim ws As Worksheet     '接点記録シート
  37.     Set ws = Worksheets("接点記録")
  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.     Dim ws As Worksheet     '接点記録シート
  96.     Set ws = Worksheets("接点記録")
  97.     ws.Cells(wrow, "B").Value = Me.TextBox1.Text      '番号
  98.     ws.Cells(wrow, "C").Value = Me.TextBox2.Text      '氏名
  99.     ws.Cells(wrow, "D").Value = Me.TextBox3.Text      '住所
  100.     ws.Cells(wrow, "E").Value = Me.TextBox4.Text      '訪問日
  101.     ws.Cells(wrow, "F").Value = Me.ComboBox1.Text     '見積
  102.     ws.Cells(wrow, "G").Value = Me.TextBox5.Text      '担当者
  103.     ws.Cells(wrow, "H").Value = Me.TextBox6.Text      '内容
  104.     ws.Cells(wrow, "I").Value = Me.TextBox7.Text      '成約日
  105.     ws.Cells(wrow, "J").Value = Me.TextBox8.Text      '金額
  106.     ws.Cells(wrow, "K").Value = Me.TextBox9.Text      '備考
  107.     MsgBox ("保存完了")
  108.     Call clear_all_data    '全項目をクリア
  109.     Call enable_menu_Button
  110.     Call disable_exec_Button
  111. End Sub
  112. Private Sub CommandButton削除実行_Click()
  113.     ws.rows(execRow).Delete
  114.     MsgBox ("削除完了")
  115.     Call clear_all_data    '全項目をクリア
  116.     Call enable_menu_Button
  117.     Call disable_exec_Button
  118. End Sub
  119.  
  120. Private Sub CommandButton中止_Click()
  121.     Call clear_all_data    '全項目をクリア
  122.     Call enable_menu_Button
  123.     Call disable_exec_Button
  124. End Sub
  125.  
  126. Private Sub CommandButton閉じる_Click()
  127.     Unload Me
  128. End Sub
  129. '全項目クリア
  130. Private Sub clear_all_data()
  131.         Me.TextBox1.Value = ""
  132.         Call clear_data
  133. End Sub
  134. 'データ部クリア
  135. Private Sub clear_data()
  136.         Me.TextBox2.Value = ""
  137.         Me.TextBox3.Value = ""
  138.         Me.TextBox4.Value = ""
  139.         Me.ComboBox1.Value = ""
  140.         Me.TextBox5.Value = ""
  141.         Me.TextBox6.Value = ""
  142.         Me.TextBox7.Value = ""
  143.         Me.TextBox8.Value = ""
  144.         Me.TextBox9.Value = ""
  145. End Sub
  146. 'データ部設定
  147. Private Sub load_data(ByVal wrow As Long)
  148.     Dim ws As Worksheet     '接点記録シート
  149.     Set ws = Worksheets("接点記録")
  150.     Me.TextBox2.Value = ws.Cells(wrow, "C").Value     '氏名
  151.     Me.TextBox3.Value = ws.Cells(wrow, "D").Value     '住所
  152.     Me.TextBox4.Value = ws.Cells(wrow, "E").Value     '訪問日
  153.     Me.ComboBox1.Value = ws.Cells(wrow, "F").Value    '見積
  154.     Me.TextBox5.Value = ws.Cells(wrow, "G").Value     '担当者
  155.     Me.TextBox6.Value = ws.Cells(wrow, "H").Value     '内容
  156.     Me.TextBox7.Value = ws.Cells(wrow, "I").Value     '成約日
  157.     Me.TextBox8.Value = ws.Cells(wrow, "J").Value     '金額
  158.     Me.TextBox9.Value = ws.Cells(wrow, "K").Value    '備考
  159. End Sub
  160.  
  161. Private Sub disable_menu_Button()
  162.     Me.CommandButton登録.Enabled = False
  163.     Me.CommandButton変更.Enabled = False
  164.     Me.CommandButton削除.Enabled = False
  165.     Me.CommandButton検索.Enabled = False
  166.     Me.TextBox1.Enabled = False
  167. End Sub
  168. Private Sub enable_menu_Button()
  169.     Me.CommandButton登録.Enabled = True
  170.     Me.CommandButton変更.Enabled = True
  171.     Me.CommandButton削除.Enabled = True
  172.     Me.CommandButton検索.Enabled = True
  173.     Me.TextBox1.Enabled = True
  174. End Sub
  175. Private Sub disable_exec_Button()
  176.     Me.CommandButton保存.Enabled = False
  177.     Me.CommandButton中止.Enabled = False
  178.     Me.CommandButton削除実行.Enabled = False
  179. End Sub
  180. Private Sub enable_hozon_Button()
  181.     Me.CommandButton保存.Enabled = True
  182.     Me.CommandButton中止.Enabled = True
  183. End Sub
  184. Private Sub enable_delete_Button()
  185.     Me.CommandButton中止.Enabled = True
  186.     Me.CommandButton削除実行.Enabled = True
  187. End Sub
  188.  
  189.  
Not running #stdin #stdout 0s 0KB
comments (?)
stdin 
Standard input is empty
stdout 
Standard output is empty
https://ideone.com/ePOZiE
language:
Text (text 6.10)
created:
2 years 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!