| |
▼かみちゃん さん：
>こんにちは。かみちゃん です。
>
>>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("ＪＣＢ顧客登録を終了します｡", 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
|
|
大山古墳
- 05/9/18(日) 12:52 -
