Excel VBA質問箱 IV

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

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


52648 / 76732 ←次へ | 前へ→

【28919】Re:ユーザーフォームがうまく動作しません。
発言  大山古墳  - 05/9/18(日) 12:52 -

引用なし
パスワード
   ▼かみちゃん さん:
>こんにちは。かみちゃん です。
>
>>excelシートを送れば見て頂けるでしょうか。その場合はどのようにすれば
>>よいでしょうか。
>
>あまり、そういう閉じた世界の話は、他に同じ悩みを抱えていたり、経験をお持ち
>のみなさんもご覧になっている掲示板の性格上、あまりしたくないのですが、コー
>ドをアップするのを躊躇されるなら、見させていただきます。
>送付先アドレスを公開(投稿者名の右のメールマーク)しておきますので、こちら
>へ送ってくださっても結構です。


ご飯を食べに行っていて、ご返事が遅れました。
申し訳ありません。
excelシートの方が見やすいと思っただけですので、下記に貼り付けて送ります。
よろしくお願いします。

Option Explicit
Dim rng登録 As Worksheet

Private Sub cmdデータ作成_Click()
'データ出力
  Dim intret As Integer
  intret = MsgBox("データ出力します", vbYesNo, "データ出力確認")
  If intret = vbYes Then
    ChDir _
    "C:"
     ActiveWorkbook.SaveAs Filename:= _
    "C:\jcb.prn" _
    , FileFormat:=xlTextPrinter, CreateBackup:=False
   
  End If
End Sub

Private Sub cmd更新_Click()
  Dim MYLASTLOW As Long, I As Long
'  行数取得
  If txt区分 = 1 Then
    MYLASTLOW = Range("A1").CurrentRegion.Rows.Count + 1
  Else
    MYLASTLOW = Range("A1").CurrentRegion.Rows.Count
  End If
'  項目移送
  Cells(MYLASTLOW, 1) = CInt(txt区分.Text)
  Cells(MYLASTLOW, 2) = CInt(txt顧客コード.Text)
  Cells(MYLASTLOW, 3) = txt氏名.Text
'  Cells(MYLASTLOW, 4) = CInt("00000")
  Cells(MYLASTLOW, 5) = txt住所1.Text
  Cells(MYLASTLOW, 6) = txt住所2.Text
  Cells(MYLASTLOW, 7) = txt住所3.Text
  Cells(MYLASTLOW, 8) = txt電話.Text
'  Cells(MYLASTLOW, 9) = CInt(txt契約日.Text)
  Cells(MYLASTLOW, 10) = CInt(txt銀行No.Text)
  Cells(MYLASTLOW, 11) = CInt(txt支店No.Text)
'  Cells(MYLASTLOW, 12) = CInt(TXT預金種目.Text)
'  Cells(MYLASTLOW, 13) = CInt(txt口座No.Text)
  Cells(MYLASTLOW, 14) = txtJCBNo.Text
'  Cells(MYLASTLOW, 15) = CInt(txt郵便.Text)
'クリア
  txt区分.Text = " "
  txt顧客コード.Text = " "
  txt氏名.Text = " "
  txt郵便.Text = " "
  txt住所1.Text = " "
  txt住所2.Text = " "
  txt住所3.Text = " "
  txt電話.Text = " "
  txt契約日.Text = " "
  txt銀行No.Text = " "
  txt支店No.Text = " "
  txt預金種目.Text = " "
  txt口座No.Text = " "
  txtJCBNo.Text = " "
  txt区分.SetFocus

End Sub

Private Sub cmd終了_Click()

  Dim MYTXTFILE As String, MYFNO As Integer
  Dim MYLASTLOW As Long, I As Long
  Dim intret As Integer
  
'終了
  intret = MsgBox("JCB顧客登録を終了します。", vbYesNo, "終了確認")
  If intret = vbYes Then
   Unload frmJCB顧客の登録
  End If
End Sub


Private Sub cmdクリア_Click()
  Dim intret As Integer
  intret = MsgBox("データを削除して宜しいですか?", vbYesNo, "クリア確認")
  If intret = vbYes Then
   Worksheets("JCB登録").Delete
   Worksheets.Add
   ActiveSheet.Name = "JCB登録"
   Columns("A:A").Select
   Selection.ColumnWidth = 1
   Columns("B:B").Select
   Selection.ColumnWidth = 7
   Columns("C:C").Select
   Selection.ColumnWidth = 20
   Columns("D:D").Select
   Selection.ColumnWidth = 5
   Columns("E:E").Select
   Selection.ColumnWidth = 20
   Columns("F:F").Select
   Selection.ColumnWidth = 20
   Columns("G:G").Select
   Selection.ColumnWidth = 20
   Columns("H:H").Select
   Selection.ColumnWidth = 14
   Columns("I:I").Select
   Selection.ColumnWidth = 6
   Columns("J:J").Select
   Selection.ColumnWidth = 4
   Columns("K:K").Select
   Selection.ColumnWidth = 3
   Columns("L:L").Select
   Selection.ColumnWidth = 1
   Columns("M:M").Select
   Selection.ColumnWidth = 8
   Columns("N:N").Select
   Selection.ColumnWidth = 15
   Columns("O:O").Select
   Selection.ColumnWidth = 7
  End If
End Sub


Private Sub TXT預金種目_AFTERUPDATE()
  If txt預金種目.Text <> 1 And txt預金種目.Text <> 2 Then
    MsgBox "預金種目エラー"
    txt預金種目.SetFocus
  End If
End Sub

Private Sub txt区分_AFTERUPDATE()
    If txt区分.Text <> 1 And txt区分.Text <> 2 Then
    MsgBox "区分エラー"
    txt区分.SetFocus
  End If
End Sub

Private Sub txtJCBNo_AFTERUPDATE()
  
End Sub

Private Sub txt銀行No_AFTERUPDATE()
  If Not IsNumeric(txt銀行No.Text) Then
    MsgBox "入力エラー"
    txt銀行No.SetFocus
  End If
End Sub

Private Sub txt契約日_AFTERUPDATE()
  Dim MYMSG As String
  MYMSG = IsDate(txt契約日.Text)
  MsgBox MYMSG
  
End Sub

Private Sub txt顧客コード_AFTERUPDATE()
'11チェック
  Dim str顧客コード As String
  Dim int顧客コード1 As Integer
  Dim int顧客コード2 As Integer
  Dim int顧客コード3 As Integer
  Dim int顧客コード4 As Integer
  Dim int顧客コード5 As Integer
  Dim int顧客コード6 As Integer
  Dim int顧客コード7 As Integer
  Dim int計 As Integer
  Dim dbl余 As Double
  Dim INTキー As Integer
  Dim NOレコード As Variant
 
  str顧客コード = Format(txt顧客コード, "0000000")
  int顧客コード1 = Mid(str顧客コード, 1, 1)
  int顧客コード2 = Mid(str顧客コード, 2, 1)
  int顧客コード3 = Mid(str顧客コード, 3, 1)
  int顧客コード4 = Mid(str顧客コード, 4, 1)
  int顧客コード5 = Mid(str顧客コード, 5, 1)
  int顧客コード6 = Mid(str顧客コード, 6, 1)
  int顧客コード7 = Mid(str顧客コード, 7, 1)
  int計 = int顧客コード1 * 7 + int顧客コード2 * 6 + int顧客コード3 * 5 + int顧客コード4 * 4 + int顧客コード5 * 3 + int顧客コード6 * 2 + int顧客コード7
  dbl余 = int計 Mod 11
  If dbl余 <> 0 Then
    Beep
    MsgBox "顧客コードエラー"
  End If
'変更区分時,データ読み込み
  If txt区分.Text = 2 Then
    Set rng登録 = Worksheets("JCB登録")
    INTキー = CInt(txt顧客コード.Text)
    NOレコード = Application.Match(INTキー, rng登録.Columns(2), 0)
    
    If IsError(NOレコード) Then
      MsgBox "レコードエラー"
    Else
      MsgBox NOレコード
      txt区分.Text = rng登録.Cells(NOレコード, 1)
      txt顧客コード.Text = rng登録.Cells(NOレコード, 2)
      txt氏名.Text = rng登録.Cells(NOレコード, 3)
      txt郵便.Text = rng登録.Cells(NOレコード, 15)
      txt住所1.Text = rng登録.Cells(NOレコード, 5)
      txt住所2.Text = rng登録.Cells(NOレコード, 6)
      txt住所3.Text = rng登録.Cells(NOレコード, 7)
      txt電話.Text = rng登録.Cells(NOレコード, 8)
      txt契約日.Text = rng登録.Cells(NOレコード, 9)
      txt銀行No.Text = rng登録.Cells(NOレコード, 10)
      txt支店No.Text = rng登録.Cells(NOレコード, 11)
      txt預金種目.Text = rng登録.Cells(NOレコード, 12)
      txt口座No.Text = rng登録.Cells(NOレコード, 13)
      txtJCBNo.Text = rng登録.Cells(NOレコード, 14)
  
    End If
  End If
End Sub

Private Sub txt口座No_AFTERUPDATE()
  If Not IsNumeric(txt口座No.Text) Then
    MsgBox "入力エラー"
    txt口座No.SetFocus
  End If
End Sub

Private Sub txt支店No_AFTERUPDATE()
  If Not IsNumeric(txt支店No.Text) Then
    MsgBox "入力エラー"
    txt支店No.SetFocus
  End If
End Sub

Private Sub txt氏名_AFTERUPDATE()

End Sub

Private Sub txt住所1_AFTERUPDATE()

End Sub

Private Sub txt住所2_AFTERUPDATE()

End Sub

Private Sub txt住所3_AFTERUPDATE()

End Sub

Private Sub txt電話_AFTERUPDATE()

End Sub

Private Sub txt郵便_AFTERUPDATE()
  If Not IsNumeric(txt郵便.Text) Then
    MsgBox "入力エラー"
  End If
End Sub

Private Sub UserForm_Initialize()

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
 
  Dim intret As Integer
 
'タイトルバーの「閉じる」ボタンを使用できなくする。
 
  If CloseMode <> 1 Then
   Cancel = 1
   intret = MsgBox("「閉じる」ボタン(×)は使用できません。" & _
     Chr(13) & "終了する場合は「終了」ボタンをクリックしてください。", _
     vbCritical, "警告")
  End If
 
End Sub
0 hits

【28913】ユーザーフォームがうまく動作しません。 大山古墳 05/9/18(日) 12:08 質問
【28914】Re:ユーザーフォームがうまく動作しません。 かみちゃん 05/9/18(日) 12:10 発言
【28915】Re:ユーザーフォームがうまく動作しません。 大山古墳 05/9/18(日) 12:23 発言
【28916】Re:ユーザーフォームがうまく動作しません。 かみちゃん 05/9/18(日) 12:31 発言
【28919】Re:ユーザーフォームがうまく動作しません。 大山古墳 05/9/18(日) 12:52 発言
【28921】Re:ユーザーフォームがうまく動作しません。 かみちゃん 05/9/18(日) 12:56 発言
【28940】Re:ユーザーフォームがうまく動作しません。 awu 05/9/19(月) 0:38 発言

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