|
Option Compare Database
'ダイアログの変数を定義
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Declare Function GetOpenFileName Lib "Comdlg32" Alias "GetOpenFileNameA" (lpofn As OPENFILENAME) As Long
'参照ボタンクリック時にファイルを開くダイアログを表示
Private Sub 参照_Click()
Dim o As OPENFILENAME
With o
.lpstrFile = String(256, vbNullChar)
.nMaxFile = LenB(o.lpstrFile)
.lpstrFilter = "テキストファイル" & vbNullChar & "*.txt;*.csv"
.lpstrInitialDir = "C:\AcpkDB"
.lStructSize = LenB(o)
End With
GetOpenFileName o
If o.lpstrFile = vbNullChar Then
MsgBox "キャンセルされました"
Me.テキスト0 = ""
Exit Sub
End If
Me.テキスト0 = Left(o.lpstrFile, InStr(o.lpstrFile, vbNullChar) - 1)
'選択したテキストファイル内のデータをテキスト1に表示する。
Dim TargetFile As String, n As Long, buf As String
n = FreeFile
TargetFile = Me.テキスト0
buf = Space(FileLen(TargetFile))
Open TargetFile For Binary As #n
Get #n, , buf
Close #n
Me.テキスト1 = buf
End Sub
'四捨五入ボタンを押したとき
Private Sub 四捨五入_Click()
Me.テキスト2 = TextConv(Me.テキスト1)
End Sub
Private Sub Form_Open(Cancel As Integer)
'フォームを開いた時点で
DoCmd.Restore
Me.テキスト0 = ""
Me.テキスト1 = ""
Me.テキスト2 = ""
'テキスト1,2は編集ロックをかける
Me.テキスト1.Enabled = False
Me.テキスト1.Locked = True
Me.テキスト2.Enabled = False
Me.テキスト2.Locked = True
End Sub
Private Sub クリア_Click()
'クリアボタンを押すことでテキスト0〜2の文字を全て消去する
Me.テキスト0 = ""
Me.テキスト1 = ""
Me.テキスト2 = ""
Me.参照.SetFocus
End Sub
Private Sub 終了_Click()
'終了ボタンを押すことで全てを終了する
DoCmd.Quit
End Sub
'四捨五入
Function TextConv(文字列 As String) As String
Const 数字データ = "0123456789.", 四捨五入 As Currency = 0.05
Dim 数字列 As Integer, 変換数値 As String
Dim Idx1 As Long, Idx2 As Long, 文字列数 As Long
TextConv = 文字列
文字列数 = Len(文字列) + 1
For Idx1 = 1 To 文字列数
If Idx1 <> 文字列数 And _
InStr(1, 数字データ, Mid(文字列, Idx1, 1), vbBinaryCompare) > 0 Then
数字列 = 数字列 + 1
Else
If 数字列 > 0 Then
変換数値 = Mid(文字列, Idx1 - 数字列, 数字列)
変換数値 = Format(Int((Val(変換数値) + 四捨五入) * 10) / 10, "0.00")
If Len(変換数値) > 数字列 Then
TextConv = Left(TextConv, Idx1 + Idx2 - 数字列 - 1) & NumStr & _
Mid(文字列, Idx1)
Idx2 = Idx2 + 1
Else
Mid(TextConv, Idx1 + Idx2 - 数字列, 数字列) = 変換数値
End If
数字列 = 0
End If
End If
Next Idx1
End Function
突然の質問失礼します。
今大変困っておりまして・・・。アクセス初心者でいま
壁にぶつかってしまいました。色々な教本を読んでもうまく参考になるものがなくて困っております。
小数第二位の四捨五入小数点0.66などふたけたのものがあり0.70と二桁を四捨五入することは出来たのですが。
内容はといいますとテキスト内の数字を探し小数点の付いた数字を指定の桁数で四捨五入して表示できるようにしたいのです、どうプログラムを書き換えてよいものかわかりません。
色々と突然質問してしまってすみません。
アクセスは2000を使ってます。
上記の作成したプログラムを実行しますと
任意のテキストファイル参照ボタンをおしてリードし
テキスト2ボックスにテキストファイル内データが表示される。
内容は以下です
これは0.88ですが0.90になります。
これは0.19ですが0.20になります。
これは0.76ですが0.80になります。
これは四捨五入です。
というものが
四捨五入ボタンを押す事で
下記のように結果変化しテキスト3ボックスに表示されます
これは0.90ですが0.90になります。
これは0.20ですが0.20になります。
これは0.80ですが0.80になります。
これは四捨五入です。
としっかり動くのですが。ここまでは良いと致しまして。
ですが文を少し変えて
このようなふうにすると。
これは0.88ですが0.90になります。
これは0.1966ですが0.20になります。
これは0.7ですが0.80555になります。
これは0.861ですが0.90に112あ.43216なりま112b.4c3216す。
これは四捨五入です。
と、結果が
これは0.90ですが0.90になります。
これは0.2066ですが0.20になります。
これはですが0.800.80なります。
これは0.860.900.900.90ああ.4320.40ま112bb.4c3c321す。
これは四捨五入です。
0.1966は0.2066となり
0.7は消えてしまい。
0.861ですが〜 860.900.900.90ああ.4320.40ま112bb.4c3c321す。
となってしまい。
このような、大変わけのわからないものになってしまい。どこがおかしいのかも良くわかりません。
もうしわけございませんがアドバイスよろしくおねがいします。
|
|