Access2000でテーブルにある氏名から特殊文字が使用されているか調査したいのです。
テーブルやVBAは下記の通りです。
顧客テーブルがあり、内容はキー番号(半角10バイト)、漢字氏名(全角50バイト)、カナ氏名(半角50バイト)です。
漢字氏名フィールドを調査して特殊文字コードが存在した場合エラーメッセージを表示したいのです。ロジックを以下の通り作成したのですが、すべての漢字氏名がエラーとなってしまいます。
なぜでしょうか？教えていただけますでしょうか。お願いいたします。
Public Sub 調査()
Dim DB As DAO.Database
Dim RS As DAO.Recordset
Dim Moji As String
Set DB = CurrentDb()
Set RS = DB.OpenRecordset("顧客テーブル", dbOpenDynaset)
Do Until RS.EOF
If RS!漢字氏名 Like "*[" & Chr("&hFA40") & "-" & Chr("&hFC4B") & "]*"
Then
Msgbox RS!漢字氏名
End If
RS.MoveNext
Loop
RS.Close: Set RS = Nothing
DB.Close: Set DB = Nothing
End Sub
VBEのWorksheet上にある、下記のコードが消えません。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub
全選択して、Deleteするのですが、消しても復活しています。
これ以上方法が思いつかないので、ご教示をおねがいします。
お世話になります。
vbaは超初心者なので、説明が良くないかもしれませんがご容赦ください。
フォーム上のレコード数を一件に制限する必要があり、下記サイトを参考に作成中のデータベースに構文をあてはめてみました。
http://hatenachips.blog34.fc2.com/blog-entry-189.html
サブフォーム移動時のプロシージャは、
Public Sub Form_Current()
Me.AllowAdditions = Me.Recordset.RecordCount < 1
End Sub
メインフォーム移動時の動作として、対象のサブフォーム名を入れて下記のような構文を
作りました。
Private Sub Form_Current()
Me.新規入力 サブフォーム.Form.Form_Current
End Sub
ところが、「コンパイルエラー 変数が定義されていません」となってしまいました。
サブフォームコントロール名はデザインビューのプロパティで、タブの「すべて」の名前の欄にあるものだと思っているのですが、もしかしてこれが違っているのでしょうか?
エラーの意味がよくわからず、困り果てています。
どなたかお力をお貸しください。
よろしくお願いします。
Excel2007で、VBAを利用した簡単なデータエントリ、管理ソフトを作成しています。
ACCESSが無いため、データベースもExcelファイルを使用しています。
ADODBで、データベース用のExcelファイルを開くのですが、エントリ数が増えるに従い、openに時間がかかるようになってきました。そのため、プログレスバーで、VBAが動作していることをアピールすることとしました。
まず、非同期接続を試したのですが、connectionを数回OpenとCloseを繰り返すと、coinitializeでエラーが出てしまい、Excelが落ちる状況となってしまうためあきらめました。
次の手段として、CreateThreadでスレッドを作成して、connectionOpenのスレッドと、プログレスバーのコントロールを分離しようと作成してみましたが、CreateThreadで作成した方のプログラムがうまいこと動作してくれません。
ConnectionOpenをメイン、プログレスバーを別スレッドにしたもの、プログレスバーをメイン、ConnectionOpenを別スレッドにしたものを両方作成してみましたが、どちらも別スレッドにした方がうまく動きません。
debug.print "test"を別スレッドの1行目に入れたところ、イミディエイトに表示されるので、処理が渡っていないわけではないようです。
また、openをメインスレッドにした時にわかっているのは、メインスレッドのADOCon.Openの行が実行されたと同時に、別スレッドが止まってしまっているようです。
もしかして、CreateThreadは割り込みがかけられないような状況では別のスレッドは動作しないのでしょうか？また、CreateThreadで作成されたスレッドは、重たい処理は無理なのでしょうか？
テスト用のデータです。
'Busyというユーザーフォームに、PBerというプログレスバーを配置
'C:\Users\xx\Desktop\に、DBファイルを配置 XXは、ユーザー名
'mihon.xlsxは、約5MB
'変数等は、両タイプとも共通
Public bRun As Boolean
Public adoCON As New ADODB.Connection
Public Declare Function CreateThread Lib "kernel32" (ByVal lpThreadAttributes As Long, _
ByVal dwStackSize As Long, ByVal lpStartAddress As Long, _
ByRef lpParameter As Long, ByVal dwCreationFlags As Long, _
ByRef lpThreadID As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'connectionOpenをメイン、プログレスバーを別スレッド
Sub AdoOpen()
Dim ThreadId As Long
Dim hThread As Long
With Busy
.BusyMes.Caption = "DB接続処理中"
.PBar.Visible = True
.PBar.Value = 0
.PBar.Min = 0
.PBar.Max = 10
.Show vbModeless
End With
DoEvents
bRun = False
hThread = CreateThread(0&, 0&, AddressOf Counter, 0&, 0&, ThreadId)
Application.Wait [NOW()+"0:00:00.5"]
With adoCON
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Properties("Extended Properties") = "Excel 12.0"
.Open "C:\Users\xx\Desktop\mihon.xlsx"
End With
bRun = True
If hThread Then
CloseHandle hThread
hThread = 0
End If
With Busy
.BusyMes.Caption = ""
.PBar.Value = 0
.PBar.Visible = False
.Hide
End With
DoEvents
End Sub
Function Counter() ' As Boolean
Dim bCountup As Boolean
Do Until bRun
Select Case Busy.PBar.Value
Case 0
bCountup = True
Case 10
bCountup = False
End Select
If bCountup Then
Busy.PBar.Value = Busy.PBar.Value + 1
Else
Busy.PBar.Value = Busy.PBar.Value - 1
End If
Sleep 500
Loop
End Function
'プログレスバーをメイン、connectionOpenを別スレッド
Sub CounterStart()
Dim bCountup As Boolean
Dim ThreadId As Long
Dim hThread As Long 'スレッドハンドル
With Busy
.BusyMes.Caption = "DB接続処理中"
.PBar.Visible = True
.PBar.Value = 0
.PBar.Min = 0
.PBar.Max = 10
.Show vbModeless
End With
DoEvents
bRun = False
hThread = CreateThread(0&, 0&, AddressOf Counter2, 0&, 0&, ThreadId)
Do Until bRun
Select Case Busy.PBar.Value
Case 0
bCountup = True
Case 10
bCountup = False
End Select
If bCountup Then
Busy.PBar.Value = Busy.PBar.Value + 1
Else
Busy.PBar.Value = Busy.PBar.Value - 1
End If
Application.Wait [NOW()+"0:00:01.5"]
Loop
If hThread Then
CloseHandle hThread
hThread = 0
End If
With Busy
.BusyMes.Caption = ""
.PBar.Value = 0
.PBar.Visible = False
.Hide
End With
DoEvents
End Sub
Function Counter2()
With adoCON
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & ObjDB.Value & "; Extended Properties=""Excel 12.0;"""
.Open "C:\Users\xx\Desktop\mihon.xlsx"
End With
bRun = True
End Function
