Excel VBA質問箱 IV

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

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


9174 / 13644 ツリー ←次へ | 前へ→

【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 発言[未読]

【28913】ユーザーフォームがうまく動作しません。
質問  大山古墳  - 05/9/18(日) 12:08 -

引用なし
パスワード
   ユーザーフォームを初めて作成しましたが、うまく動作しません。
よろしくお願いします。

1.登録画面を作成しました。項目入力後、更新ボタン押下でexcleシートに
  転記し、画面クリアし入力を繰り返します。
2.excleシートに転記、画面クリア、先頭項目にフォーカス移動までうまくいきます。
  しかし、先頭項目にカーソルはありますが、入力出来なくなってしまいます。
  どのキーも受け付けません。

この後、どのようにdebugしていけば良いでしょうか。
ご助言をお願いします。

【28914】Re:ユーザーフォームがうまく動作しませ...
発言  かみちゃん  - 05/9/18(日) 12:10 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>2.excleシートに転記、画面クリア、先頭項目にフォーカス移動までうまくいきます。
>  しかし、先頭項目にカーソルはありますが、入力出来なくなってしまいます。
>  どのキーも受け付けません。

どのようなコードを書かれたのか、提示していただけませんか?

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

引用なし
パスワード
   ▼かみちゃん さん:
>こんにちは。かみちゃん です。
>
>>2.excleシートに転記、画面クリア、先頭項目にフォーカス移動までうまくいきます。
>>  しかし、先頭項目にカーソルはありますが、入力出来なくなってしまいます。
>>  どのキーも受け付けません。
>
>どのようなコードを書かれたのか、提示していただけませんか?

早速のご返事をありがとうございます。
excelシートを送れば見て頂けるでしょうか。その場合はどのようにすれば
よいでしょうか。
e-mailの添付のようにできるのでしょうか?
よろしくお願いします。

【28916】Re:ユーザーフォームがうまく動作しませ...
発言  かみちゃん E-MAIL  - 05/9/18(日) 12:31 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>excelシートを送れば見て頂けるでしょうか。その場合はどのようにすれば
>よいでしょうか。

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

【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

【28921】Re:ユーザーフォームがうまく動作しませ...
発言  かみちゃん E-MAIL  - 05/9/18(日) 12:56 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>excelシートの方が見やすいと思っただけですので、下記に貼り付けて送ります。
>よろしくお願いします。

ご配慮ありがとうございます。
ただ、こちらで同一シートをこれから作らないと検証できないので、差し支えなけ
ればシートを送っていただけると、手間が省けて助かります。
(と、言動と行動が伴っていないのは、重々承知です。)

【28940】Re:ユーザーフォームがうまく動作しませ...
発言  awu  - 05/9/19(月) 0:38 -

引用なし
パスワード
   > この後、どのようにdebugしていけば良いでしょうか。

Private Sub txt顧客コード_AFTERUPDATE()

の中に、

txt顧客コード.Text = rng登録.Cells(NOレコード, 2)

がありますので、この2箇所にブレークポイントを置いてデバッグすると良いでしょう。

チラッと見た感じ、ループになっている可能性あり。

txt顧客コード.Text = "" Then Exit Sub を初めに挿入するとか・・・

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