VB6のテキストボックスに入力していると、途中で急に文字が消えてしまうのは何故?

質問

ＶＢ６で、テキストボックスを使ったツールを作ったのですが、起動して文字を入力していると、途中で急に入力した文字が消えてしまいます。
ただ入力を続けているだけなのに、何故でしょう?
文字数とかが関係しているのでしょうか?
そんなに文字数は入れてないんですが・・・。
どなたか教えてください!!　お願いします!!

回答No.10

haporun · ベストアンサー

修正がある程度完了したら、またここに書いてみてください。
圧倒的に量が減っていると思います。

これからもサポートしていきたいと思いますので、あきらめずに続けてみてください。

>本を購入してきてその中のパターンを真似ているだけ
どの文がどういう動作をしているのかわからなかったら、本で調べるのもいいですし、ここで質問するのもいいでしょう。
ただし、質問する前にキーワードで検索したほうがいいです。

Stopステートメントのほかに、もう1つ便利なデバッグ方法。
ある行でF9を押してみましょう。
その行の色が変わります。
それから実行すると、その行に来ると必ず止まってくれます。

Text1.Text = .....

が書いてある行をすべてF9で色を変えてから実行し、止まったら、右辺(イコールの右の変数)にマウスポインタを当ててみましょう。
するとその変数の内容を表示してくれます。

お礼

こんにちは。色々と解説いただきありがとうございました。Stopステートメントは試してみましたが、次から次とストップしてしまい、結局原因の個所は特定できませんでした。とりあえず、ポイントがありますのでこの質問は締めさせていただきました。ほんとに参考になりました。ありがとうございました。日々疑問が出てくるので、また別の枠で質問をさせていただこうかと思います。その時はまたよろしくお願いしますね！お世話様でした。では。

回答No.9

haporun

んんん。
これがフォーム上のコードすべてですか?

いろんなところに

If Text1.Text = "" Then Stop

を書いて、どの時点でテキストボックスのなかみが消えているか特定はできましたか?
このコードを見ても、名前が何のコントロールの名前なのか予測できないので、なんともいえません。

すみません、自信なくなってきました。

APIやカスタムコントロールを使っているので、いろいろ勉強なさっているとは思いますが、さすがにこれでは見やすいコードとはいえません。
コードを見やすく、無駄なく書き直せば、多少デバッグ効率が上がると思うのですが・・・。

○ ファイル名を作成する作業は何度も使うので、関数にしたほうがいい。

Function MakePathName(File As string) As String

MakePathName = App.Path + "\" + Replace(File, "/", "")

End Function

とか。

○ Weekday(startdate)を何度も呼び出すのは効率が悪いので、それを変数に入れてSelect Caseすればかなりコードが減る。

Dim Wd As Long, WdName

Wd = Weekday(startdate)

WdName = Array("日", "月", ・・・"土")
Form1.Label2.Caption = WdName(Wd)

Select Case Wd

Case 1

'赤にする文

Case 2 To 7

'黒にする文

End Select

ってな感じ。

○ Format(startdate, "mm/dd")もなんども呼び出してはダメ。

Dim Sd As String
Sd = Format(startdate, "mm/dd")

Select Case Sd

Case "01/01", "02/11",・・・"12/23"

'赤にする文

End Select

VBにはSelect Caseというほかの言語にはあまりない便利な分岐文があるので、利用しましょう。

○ Dimはサブルーチンの最初にまとめて書いたほうが良い○ Dimは,(コンマ)で1度に複数宣言できるので、同じような意味を持つ変数は同時に宣言

○ Timer1_Timerイベントにて、GetPrivateProfileStringに渡すファイル名やキー名は不変なので、フォーム内の(Declarations)で宣言し、Form_Loadで値を代入したほうがよい。

なんども同じ値を入力するのは無駄です。

なんだか、あまり関係ないことしか言ってませんが、他人に聞くときは、他人に見やすいコードを書くことも重要なのです。

お礼

丁寧な解説ありがとうございます。ほんとに色々なやり方があるんですね。私の場合は、勉強してるというよりも、色々な本を購入してきて、その中のパターンを真似ているだけなので、実際にはよく理解できていないんです。しかも、本では今自分が求めるコードがどれなのかもよく分かりませんし。誰かに説明していただくと、すごく参考になります。とりあえず書いていただいたものは全部試してみたいと思います！

回答No.8

haporun

このプログラムでは何のイベントなのかわからないのですが、カレンダーの日付クリックイベントなのでしょうか。
Private Sub ～～～()から書いてほしかったです。

このイベントが、タイマーやキーイベントなどのリアルタイムなイベントでない限り、テキストボックスに文字を入力中に文字が勝手に消えてしまうということはありえません。
やはりPrivate Sub ～～～()の部分がわからないことにはどうにも・・・。
あと、貼り付けているコントロールやそのコントロールで発生するイベントなどを補足してくだされば、おそらく解決の糸口は見つかるかと思います。

このようにどの時点で不具合が起こっているかわからないようなときは、それを起しうるイベントが特定できなければ、解決のしようがありません。
いろんなところに

If Text1.Text = "" Then Stop

を書いておくのも手です。
こうすれば、テキストが空になった時点でコードが中断し、場所を特定できます。

ちなみに、プログラム上のアドバイスを。

App.Pathは通常 "C:\Temp" などの、最後に "\" を含んでいない文字を保持していますが、プログラムがルートにある場合は "C:\" などと最後に "\" が含まれています。
このため、App.Path + filename とすると、\がダブってしまう可能性もあるということです。
プログラムの腕が上達してきて、配布などを考えることがあれば、この点は無視できません。

また、同じフォーム上のコントロールを指定するのに、Form1.Text1 のように Form1 と指定するのはオススメできません。

補足

ありがとうございます。ツールの内容は以下のとおりです。
Option Explicit
Private Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal naiyou As String, ByVal lpFileName As String) As Long
Private Sub clear_Click()
Form1.Label1.Caption = ""
Form1.Label2.Caption = ""
Form1.Text1.Text = ""
End Sub
Private Sub Command1_Click()
Dim out2 As String
Dim day As String
Dim filename As String
Dim henkan As String
Dim henkan2 As String
Dim ans As String
If Label1.Caption = "" Then
MsgBox "****************** ", vbCritical
Exit Sub
Else
If Text1.Text = "" Then
ans = MsgBox("******************", vbYesNo + vbQuestion
If ans = vbNo Then
Exit Sub
End If
End If
End If
henkan = Form1.Label1.Caption
henkan2 = Replace(henkan, "/", "")
filename = "\" & henkan2 & ".txt"
If Dir(App.Path & filename) = "" Then
out2 = Text1.Text
Open App.Path & filename For Output As #1
Print #1, out2
Close #1
Else
ans = MsgBox("******************", vbYesNo + vbQuestion
If ans = vbNo Then
Exit Sub
Else
Kill Dir(App.Path & filename)
out2 = Text1.Text
Open App.Path & filename For Output As #1
Print #1, out2
Close #1
End If
End If
End Sub
Private Sub copy_Click()
Clipboard.SetText Form1.Text1.SelText
End Sub
Private Sub cut_Click()
Clipboard.SetText Form1.Text1.SelText
Form1.Text1.SelText = ""
End Sub

Private Sub keep_Click()
Call Command1_Click
End Sub

Private Sub logon_Click()
optionman.Show
End Sub

Private Sub paste_Click()
Form1.Text1.SelText = Clipboard.GetText
End Sub
Private Sub fin_Click()
Unload Me
Unload myplan
End Sub
Private Sub monthview1_selchange(ByVal startdate As Date, _
ByVal enddate As Date, Cancel As Boolean)
Form1.Label1.Caption = startdate
If Weekday(startdate) = 1 Then
Form1.Label2.Caption = "日"
Form1.Label2.ForeColor = vbRed
Form1.Label1.ForeColor = vbRed
End If
If Weekday(startdate) = 2 Then
Form1.Label2.Caption = "月"
Form1.Label2.ForeColor = vbBlack
Form1.Label1.ForeColor = vbBlack
End If
If Weekday(startdate) = 3 Then
Form1.Label2.Caption = "火"
Form1.Label2.ForeColor = vbBlack
Form1.Label1.ForeColor = vbBlack
End If
If Weekday(startdate) = 4 Then
Form1.Label2.Caption = "水"
Form1.Label2.ForeColor = vbBlack
Form1.Label1.ForeColor = vbBlack
End If
If Weekday(startdate) = 5 Then
Form1.Label2.Caption = "木"
Form1.Label2.ForeColor = vbBlack
Form1.Label1.ForeColor = vbBlack
End If
If Weekday(startdate) = 6 Then
Form1.Label2.Caption = "金"
Form1.Label2.ForeColor = vbBlack
Form1.Label1.ForeColor = vbBlack
End If
If Weekday(startdate) = 7 Then
Form1.Label2.Caption = "土"
Form1.Label2.ForeColor = vbBlack
Form1.Label1.ForeColor = vbBlack
End If
If Format(startdate, "mm/dd") = "01/01" Then
Form1.Label1.ForeColor = vbRed
Form1.Label2.ForeColor = vbRed
End If
If Format(startdate, "mm/dd") = "02/11" Then
Form1.Label1.ForeColor = vbRed
Form1.Label2.ForeColor = vbRed
End If
If Format(startdate, "mm/dd") = "04/29" Then
Form1.Label1.ForeColor = vbRed
Form1.Label2.ForeColor = vbRed
End If
If Format(startdate, "mm/dd") = "05/03" Then
Form1.Label1.ForeColor = vbRed
Form1.Label2.ForeColor = vbRed
End If
If Format(startdate, "mm/dd") = "05/04" Then
Form1.Label1.ForeColor = vbRed
Form1.Label2.ForeColor = vbRed
End If
If Format(startdate, "mm/dd") = "05/05" Then
Form1.Label1.ForeColor = vbRed
Form1.Label2.ForeColor = vbRed
End If
If Format(startdate, "mm/dd") = "07/20" Then
Form1.Label1.ForeColor = vbRed
Form1.Label2.ForeColor = vbRed
End If
If Format(startdate, "mm/dd") = "09/15" Then
Form1.Label1.ForeColor = vbRed
Form1.Label2.ForeColor = vbRed
End If
If Format(startdate, "mm/dd") = "11/03" Then
Form1.Label1.ForeColor = vbRed
Form1.Label2.ForeColor = vbRed
End If
If Format(startdate, "mm/dd") = "12/23" Then
Form1.Label1.ForeColor = vbRed
Form1.Label2.ForeColor = vbRed
End If
If Format(startdate, "mm/dd") = "01/02" Then
Form1.Label1.ForeColor = vbRed
Form1.Label2.ForeColor = vbRed
End If
If Format(startdate, "mm/dd") = "01/03" Then
Form1.Label1.ForeColor = vbRed
Form1.Label2.ForeColor = vbRed
End If
Dim day As String
Dim filename As String
Dim henkan As String
Dim henkan2 As String
Dim readdata As String
Dim readend As String
Dim filename2 As String
henkan = Form1.Label1.Caption
henkan2 = Replace(henkan, "/", "")
filename = "\" & henkan2 & ".txt"
filename2 = "\" & henkan2 & ".dat"
If Dir(App.Path & filename) = "" Then
Form1.Text1.Text = ""
Else
Open App.Path & "\" & filename For Input As #1
Do Until EOF(1)
Line Input #1, day
readdata = readdata & day & vbCrLf
Loop
readend = Replace(readdata, "", "")
Close #1
Form1.Text1.Text = readend
End If
End Sub
Private Sub plan_Click()
myplan.Show
If Form1.Label1.Caption = "" Then
MsgBox "******************", vbExclamation
Unload myplan
Else
myplan.Label1.Caption = "20" & Form1.Label1.Caption & " (" & Form1.Label2.Caption & ")"
End If
End Sub

Private Sub Timer1_Timer()
Dim filename As String
Dim henkan As String
Dim henkan2 As String
Dim filename2 As String
henkan = Form1.Label1.Caption
henkan2 = Replace(henkan, "/", "")
filename2 = "\" & henkan2 & ".dat"
If App.Path & filename2 = "" Then
Form1.Label6.Caption = ""
Else
Dim strFileName As String
Dim strSectionName As String
Dim strKeyName As String
Dim strValue As String * 1024
Dim lngStrLength As Long
Dim lngResult As Long
strFileName = App.Path & filename2
strSectionName = "nikki"
strKeyName = "plantext"
lngStrLength = Len(strValue)
lngResult = _
GetPrivateProfileString( _
strSectionName, _
strKeyName, _
"", _
strValue, _
lngStrLength, _
strFileName)
Form1.Label6.Caption = _
Left(strValue, _
InStr(strValue, _
vbNullChar) - 1)
End If
Form1.Label6.Left = Form1.Label6.Left - 50
If Form1.Label6.Left + Form1.Label6.Width < 0 Then
Form1.Label6.Left = Form1.Label6.Width
End If
End Sub

Private Sub version2_Click()
Version.Show
End Sub
カレンダーの日付をクリックして、ラベルに日付を表示→テキストの内容を書いて、最後に「保存」専用ボタンを押す→yymmdd.txtに内容をセーブする→保存した日付をクリックすると、その日付のyymmdd.txtを読み込んでテキストボックスに表示する　というものです。
あと、予定登録に文字を入れると、ファイルにセーブして、画面下のラベルを文字が流れて表示されるというのもあります。
こんなんでお分かりいただけるでしょうか。見当違いだったらごめんなさい！！！

回答No.7

kirara_pika

>If Dir(App.Path & filename) = "" Then
>Form1.Text1.Text = ""
>Else
の部分なんですけど、ファイル名が見つからなかったらテキストボックスの内容をクリアするってことですよね。
最初このファイルは存在するのでしょうか？
ファイルが存在しない場合実行しても結果はずっと同じですよ。
あらかじめApp.Pathの場所にそのファイルがあれば別ですが。
まず、if～の前に
Open App.Path & "\" & filename For Append As #1
Close #1
で空のテキストファイルを作ってみては？

補足

私の説明が至りませんでした。テキストボックスの内容をテキストファイルにセーブするようにしているので、最初は
If Dir(App.Path & filename) = "" Then
Form1.Text1.Text = ""
としないと、ファイルが存在しないということでエラーになるんです。
一度セーブすれば、次に対象の日付をカレンダーからクリックすると、その日付のファイルを読み込んでテキストボックスに表示するようにしています。

回答No.6

haporun

文字が消えてしまうというのは、すべてですか?

これ以降の文は対象がText1であると仮定します。
編集メニューの検索で

"Text1.Text = "

という文字列を検索して、その付近のコードを調べてみましょう。

あと、Text1_Changeイベントに変なコードが入っていませんか?

消える文字が1文字とか数文字なら、KeyPress、KeyDown、KeyUpイベントも怪しいです。

>テキストボックスを使ったツール
できれば何をするツールなのか知りたいです。

ちなみにほかの方が語ってらっしゃる

Do Events

という文は

DoEvents

の間違いです。
単語を離してはいけません。

補足

文字が消えるのは、それまでにテキストボックスに入力した文全てです。ちなみに、ツールというのは日記帳です。
カレンダーの日付をクリックして、ラベルに日付を入れ、テキストボックスに内容を記入→保存ボタンで保存すると、次からはその日付をクリックするとテキストファイルを読み込んでテキストボックスに内容が表示される　というものです。
一番怪しいのは、この辺りだと思うのですが。

Dim day As String
Dim filename As String
Dim henkan As String
Dim henkan2 As String
Dim readdata As String
Dim readend As String
Dim filename2 As String
henkan = Form1.Label1.Caption
henkan2 = Replace(henkan, "/", "")
filename = "\" & henkan2 & ".txt"
filename2 = "\" & henkan2 & ".dat"
If Dir(App.Path & filename) = "" Then
Form1.Text1.Text = ""
Else
Open App.Path & "\" & filename For Input As #1
Do Until EOF(1)
Line Input #1, day
readdata = readdata & day & vbCrLf
Loop
readend = Replace(readdata, "", "")
Close #1
Form1.Text1.Text = readend
End If
End Sub

ちょっと変な感じですが、なにぶん初心者なもので・・・。
KeyPress、KeyDown、KeyUpイベントは使っていません。
それと、Text1_Changeイベントというのはどこにもないんですが、どういうものなんでしょうか？

回答No.5

kirara_pika

半角文字が1バイト、全角文字が2バイトです。
キロバイトはバイトの1024倍ですから、32キロバイトだと
半角32768文字位、全角16384文字位ということですか。

補足

全角16384文字というのは、かなりの文字数ですよねぇ。とてもではないですが、そんな文字数は入力していません。1000文字とか2000文字くらいのレベルですから。

回答No.4

kirara_pika

「Do Events」をお分かりでないようなのでこの関数は使われていないようですね。Do～Loop内ではないようです。

TextBoxのプロパティMultiLineがTrueになってませんか？
TrueになっているとTextBoxの端で改行されて入力した文字は上にいって隠れてしまう状態になります。消えているわけではありませんが・・・・

補足

MultiLineはtrueにしています。で、スクロールバーを縦横両方に付けています。画面の上にいったのではなく、いくら見ても消えているんです。前にも同じようなテキストボックスを使用したツールを使った時に、入力中に急に消えてしまったことがあったので、何かの設定で、よくあることかと思っていましたが、そうでもないようですね。

回答No.3

ponnta

TextBoxはMultiLinがFalseのときに半角で2048文字、
Trueのときで約３２ｋバイトまでという制限がありますが・・・

補足

３２ｋというのは実際にはどれくらいの文字数なのでしょうねぇ？そんなには文字を入れていないんです。

回答No.2

ykkw_2001

テキストボックス（たとえばText1）に、代入しているようなところをチェックしなおして見てはどうでしょう？

回答No.1

kirara_pika

プログラム中Do Eventsなどでテキストボックスの内容をクリアするような記述はありませんか？

補足

早速ご回答いただき、ありがとうございます。
テキストボックスでは、Open ～ For Input As で一度保存した
テキストファイルをDo Until ～ Loopでテキストファイルの最終行まで
読み込んで、テキストボックスに表示するというコードを書いてます。
Doを使ってるのはここだけです。
保存前の全くのプランク状態からテキストボックスに文を入力している
途中で急に消えてしまうので、これは関係なさそうです。
うぅ～ん、分かりません。
やっぱりDoが関係しているんでしょうか？