ＶＢ６編、Sampleのインデックス

ちょっとしたこと

データベース関係

コントロール関係

リストビューに表示する
IEを起動させる
コモンダイアログボックス
リッチテキストボックスのテキストの検索、色付け
WebBrowserのメソッド

リリースする前に

．CHMとは？
アイコンの作り方
文字アイコンの作り方

自分の居場所を知る関数
自分の居場所というのは、ＥＸＥがいるフォルダなりファイルへのパスを取得することで知ることが出来ます。アプリケーションの各種設定をテキストファイルに保存し、次回起動時にはそこから読み込んで起動させるということが必要になってきます。その時そのテキストファイルはＥＸＥがある場所にしなければいけませんが、アプリケーションをインストール人によってまた、ＰＣの環境によってＥＸＥの場所はさまざまです。そんな時ＥＸＥの場所を取得する関数が

App.Path

というものです。探すときに何だったっけ？と思わないようにこんなものも標準モジュールに置いておくと便利です。とにかくよく使う関数は「標準モジュール」まとめておきましょう！！

IEを起動させる
　アプリケーションからIEを起動させるには、

Private Sub Command1_Click()
　　　　Dim v
　　　　　　　　　　　'exeのある場所を指定　　　　　　　　　　　　　　　　　　　　　　　表示方法を指定
　　　　v = Shell("C:\Program Files\Internet Explorer\IEXPLORE.EXE", vbNormalFocus)
End Sub

とします。NTや2000などOSによってEXEの場所が違うことに注意してください。そういう場合を考えて Formに「WebBrowser」（インターネットコントロール）コントロールを追加して、

Private Sub Command1_Click()
　　　　WebBrowser1.navigate "http://www22.0038.net/~sanjyuiti/"
End Sub

とやってしまう方法などがあります。
　もう一つ

Private Sub Command1_Click()

Dim ob As Object
Set ob = CreateObject("InternetExplorer.application")
ob.navigate "http://www22.0038.net/~sanjyuiti/"
ob.Visible = True
Set ob = Nothing

End Sub

てな方法もあります。いろいろ使い分けてください。

WebBrowserのメソッド
　WebBrowserのヘルプファイルは確かWIN98のCD-ROMの中にあります。
持ってない人は友達に分けてもらってください。こういうところがマイクロソフトって謎なんですよね。プログラマー泣かせでもあります。
　さて、そのWebBrowserで、よく使うのがプリントプレビューのメソッドです。

Private Sub Command1_Click()
　　　'印刷プレビュー
　　　WebBrowser1.ExecWB OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DODEFAULT
End Sub

この他にも、「ExecWB」の後にインテリセンスが出てきますので参考にすることが出来ます。

文字列の中の空白を削除する
　TirmやRtrim、LTrimは便利な空白スペース削除関数ですが、文字列の中のスペースを削除するには

Private Sub Command1_Click()
　　　Text1.Text = Replace(Text1.Text, " ", "")
　　　Text1.Text = Replace(Text1.Text, "　", "")
End Sub

とします。気をつけたいのが、半角スペースと全角スペースを両方処理することです。でないと、消えない？と悩むことになります。

Accessの操作などにはＤＡＯを使う
　Ａｃｃｅｓｓの操作、例えばｍｄｂ間でのテーブルのリンク、テーブルのエクスポート等には、ＤＡＯが便利です。でも、ＤＡＯのヘルプがなんかＭＳＤＮでは調べにくいし、見難いです。そこでですが、「プロジェクト」－「参照設定」で、マイクロソフトDAO3.6オブジェクトライブラリを設定してから、コードに

Dim db As DAO.Database

と書いて、Databaseの中にカーソルを入れてF１キーを押してみてください。すると、複数の候補が出てくるので DAOを選びます。するとDAO3.6．CHMが開きます。CHMファイルはMSDNとは独立しているファイルのはずなので「．CHM」で適当に検索しても見ることが出来ます。検索すると沢山のファイルが出てきます。適当にショートカットを作っておけば、いつでも見られるというわけです。
　ちなみに、サンプルも豊富ですので結構重宝します。他にも有効な．CHMを探しておくのもよいかと思います。結構面白い情報があるとおもいます。

．CHMとは？
　先ほど出てきたCHMですが、自分で作ることも出来ます。詳細はご自分のPCの「htmlhelp.chm」を広げてみて下さい。
自作アプリのヘルプが簡単に出来ます。また、フリーの使い勝手のよいヘルプ作成アプリケーションもネットに転がっていますので私はよく使わせてもらっています。
　また、「KeiYu HelpLab」分かりやすくかつ詳しく解説されているホームページもあります。
　こちらに簡単にＣＨＭを作成できるソフト「ヘルプましん」が紹介されています。

SQL構文を調べるには？
　コードで

select

と書いてカーソルを合わせてF1キーを押してみてください。VB、とVBAの選択でVBを選べば、「Jet　SQLリファレンス」 が開きます。ちょっとしたSQL文など使用例もありますので、役立つと思います。　

アイコンの作り方
　アプリケーションを自作した後,、オリジナルなアイコンを使いたいものです。
　フリー、シェアでも沢山のアイコンがネットにはありますが、自分でも作りたいものです。
　作成方法は簡単です。
　ビジュアルスタジオの二枚目のＣＤ－ＲＯＭの中の何処だったかに「IMAGEDIT.EXE 」というファイルがあります。これガあるフォルダごとＰＣにコピーして、起動させるとイメージエディタが立ち上がります。
「フェイル」－「新規作成」-「アイコン」-「ＶＧＡ」でマス目がいっぱいのエディタ画面が現われます。お好みの絵や文字を書き込んで保存すれば出来あがり！。
　とっても簡単に出来ます。シェアでなんて勿体無いです。と思うのは私だけか？

文字アイコンの作り方
　　絵は何とか描けるが文字となると、とたんに苛立ちが出てきます。
　でも、方法が分かれば簡単です。その方法とは、
「ワードで好きな文字を好きな書体で書く」－「コピーしてペイントへ貼り付ける」－「ペイントからコピーしてイメージエディタへ貼り付ける」で、ＯＫ！
　後は色をつけたり変えたり。ディスクトップに文字アイコンの出現！
　

VBのソースをＨＴＭＬ化するサンプルコード

　フォームにボタン２つ、テキストボックス１つ、コモンダイアログボックスを１つ貼り付けて以下のコードを書いて実行。　因みに以下のＨｔｍｌはこのツールでコンバートしたものにちょっと手を加えたもの。

Private　Sub　Command1_Click()
　　'ファイルを開く
On　Error　GoTo　ErrHandler

’コモンダイアログボックス
　　　　　CommonDialog1.CancelError　=　True
　　　　　CommonDialog1.Filter　=　"すべてのファイル　(*.*)|*.*|"　_
　　　　　&　"テキスト　ファイル　(*.txt)|*.txt|バッチ　ファイル　(*.bat)|*.bat"
　　　　　CommonDialog1.FilterIndex　=　2
　　　　　CommonDialog1.ShowOpen
　　　　　Text1.Text　=　CommonDialog1.FileName
Exit　Sub
ErrHandler:
　　'　ユーザーが　[キャンセル]　ボタンをクリックしました。
End　Sub

Private　Sub　Command2_Click()
　　　　　If　Text1.Text　＜＞　""　Then
　　　　　　　　Dim　intFNo　As　Integer
　　　　　　　　intFNo　=　FreeFile
　　　　　　　　
　　　　　　　　Dim　Readline　As　String
　　　　　　　　Dim　stKakou　As　String
　　　　　　　　
　　　　　　　　Open　Text1.Text　For　Input　As　#intFNo
　　　　　　　　
’ファイル読み込み
　　　　　　　　　　　　　　　　Do　Until　EOF(intFNo)
　　　　　　　　　　　　　　　　　　　　
　　　　　　　　　　　　　　　　　　　　Line　Input　#intFNo,　Readline
　　　　　　　　　　　　　　　　　　　　stKakou　=　stKakou　&　vbCrLf　&　Readline
　　　　　　　　　　　　　　　　Loop
　　　　　　　　
　　　　　　　　Close　#intFNo
　　　　　　　　
　　　　　Else
　　　　　　　Exit　Sub
　　　　　　　
　　　　　End　If
　　　　　
　　　　Debug.Print　stKakou
’自作関数へ処理を飛ばす
　　　　stKakou　=　HtmlKakou(stKakou)
　　　　
　　　　　　　　intFNo　=　FreeFile
’ファイル書き込み
　　　　　　　Open　Text1.Text　For　Output　As　#intFNo
　　　　　　　　　　Print　#intFNo,　stKakou
　　　　　　　Close　#intFNo
　　　　　MsgBox　"加工終了",　vbInformation,　App.Title
End　Sub

Private　Function　HtmlKakou(ByVal　Moji　As　String)　As　String
'VBソースをHTML形式に書き換える
'全角スペースに変換
　　Moji　=　Replace(Moji,　" ",　"　")
'HTMLタグの＜＞を＜＞全角に置き換える
　Moji　=　Replace(Moji,　"＜",　"＜")
　Moji　=　Replace(Moji,　"＞",　"＞")

'改行記号をタグと改行記号に置き換え
　　Moji　=　Replace(Moji,　vbCrLf,　"＜br＞"　&　vbCrLf)
　　
　　
'コメント箇所を色タグで囲む
　　Dim　LoKomeHjime　As　Long:　LoKomeHjime　=　1
　　Dim　LoKomeOwari　As　Long
　　
　　　　　　　　Do
　　　　　　　　　　LoKomeHjime　=　InStr(LoKomeHjime,　Moji,　"'")
　　　　　　　　　　　　If　LoKomeHjime　=　0　Then
　　　　　　　　　　　　　　　Exit　Do
　　　　　　　　　　　　End　If
　　　　　　　　　　LoKomeOwari　=　InStr(LoKomeHjime　+　1,　Moji,　vbCrLf)
　　　　　　　　　　　　　Moji　=　Left(Moji,　LoKomeHjime)　&　"＜font　color="　&　""""　&　"#008040"　&　""""　&　"＞"　&　Mid(Moji,　LoKomeHjime　+　1,　LoKomeOwari　-　LoKomeHjime)　&　"＜/font＞"　&　Mid(Moji,　LoKomeOwari)
　　　　　　　　
　　　　　　　　　　LoKomeHjime　=　LoKomeOwari
　　　　　　　　Loop　Until　LoKomeHjime　=　0
　　
　　Debug.Print　Moji
'テーブルタグで囲む

’ＶＢコードから「”」を書き込む
　　Moji　=　"＜table　bgcolor="　&　""""　&　"#fdfeed"　&　""""　&　"　width="　&　""""　&　"100%"　&　""""　&　"　cellspacing="　&　""""　&　"2"　&　""""　&　"＞＜tr＞＜td＞"　&　Moji　&　"＜br＞＜br＞＜/td＞＜/tr＞＜/table＞＜br＞"
　　

　　
　　HtmlKakou　=　Moji
End　Function

オブジェクトの参照渡しと値渡し
set = nothingの実行内容検分

Private　Sub　Command1_Click()
'ちょっと正確には解らないけれど、コントロールオブジェクトの場合アドレスが渡されるようです。
つまり、メモリ上の場所というわけ。ＭＳＤＮでは参照渡しのほうが紹介されていました。ＣやＣ++のポインタ的なもの。多分。因みに参照渡しのほうが早いとのこと。
　　　　Debug.Print　ObjPtr(Me.RichTextBox1);　"オブジェクトのアドレス"
　　　　Call　参照渡し(Me.RichTextBox1)
　　　　Call　値渡し(Me.RichTextBox1)
　　　　
　　　　End
　　　　
End　Sub
Option　Explicit

Public　Sub　参照渡し(ByRef　Ob　As　RichTextBox)
　　　　Ob.Text　=　"参照渡し"
　　　　Ob.Left　=　Form1.ScaleWidth　-　Ob.Width
　　　　Debug.Print　Ob.Name
　　　　Debug.Print　VarPtr(Ob);　"変数のアドレス"
　　　　Debug.Print　ObjPtr(Ob);　"オブジェクトのアドレス"
　　　　
　　　　If　Not　Ob　Is　Nothing　Then
　　　　　　Set　Ob　=　Nothing　'ただ単に参照を止めているだけの話　とうか処理である。
　　　　　　MsgBox　""
　　　　End　If
　　　　　　　
　　　　Debug.Print　VarPtr(Ob);　"変数のアドレス"
　　　　Debug.Print　ObjPtr(Ob);　"オブジェクトのアドレス"
End　Sub
Public　Sub　値渡し(ByVal　Ob　As　RichTextBox)
　　　　Ob.Text　=　"値渡し"
　　　　Ob.Left　=　0
　　　　Debug.Print　Ob.Name
　　　　
　　　　Debug.Print　VarPtr(Ob);　"変数のアドレス"
　　　　Debug.Print　ObjPtr(Ob);　"オブジェクトのアドレス"　'参照渡しと　同じオブジェクトアドレスを参照している
End　Sub

'AddressOf　関数のアドレスを得る演算子
'VarPtr()　変数のアドレスを得る関数
'StrPtr()　文字列のアドレスを得る関数
'ObjPtr()　オブジェクトのアドレスを得る関数

'Hex

デバックの結果
　24551344　オブジェクトのアドレス
RichTextBox1
　8387028　変数のアドレス
　24551344　オブジェクトのアドレス
　8387028　変数のアドレス
　0　オブジェクトのアドレス
RichTextBox1
　8386872　変数のアドレス
　24551344　オブジェクトのアドレス

リッチテキストボックスのテキストの検索、色付け

’とにかく　InStr(lngKoko,　Rich2.Text,　"検索文字")が味噌。これでかなり早くなります。
　Dim　lngKoko　as　Long　　　　　　
　lngKoko=1か0
　Do　　　　
　　　lngKoko　=　InStr(lngKoko,　Rich2.Text,　"検索文字")
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　
　　　　　If　lngKoko　=　0　Then
　　　　　　　　　Exit　Do
　　　　　　Else
　　　　　　　　Rich2.SelStart　=　lngKoko　-　1
　　　　　　　　Rich2.SelLength　=　Len("検索文字")
　　　　　　　　Rich2.SelColor　=　RGB(255,　0,　0)　
　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　
　　　　　　　lngKoko　=　lngKoko　+　Len("検索文字")
　　　　　　end　if
　Loop　Until　lngKoko=0

Accessの2つのセキュリティー　それぞれの接続方法。　ユーザー追加方法など

Private　Sub　Command1_Click()

On　Error　GoTo　SOS

'データベースパスワード時の接続
Dim　rs　As　ADODB.Recordset
Dim　cn　As　ADODB.Connection
Set　cn　=　New　ADODB.Connection
cn.ConnectionString　=　"Provider=Microsoft.Jet.OLEDB.4.0;"　_
&　"User　ID=admin;"　_
&　"Data　Source=C:\db1.mdb;"　_
&　"Jet　OLEDB:Database　Password=123;"　_
&　"Persist　Security　Info=False"
cn.Open
cn.Close

'-----------------------------------------------------------------------------------------------
'ユーザーやグループごとにデータベースオブジェクト操作にたいする権限設定時
Dim　cnn　As　New　ADODB.Connection
cnn.Provider　=　"Microsoft.Jet.OLEDB.4.0;"
cnn.Properties("Jet　OLEDB:System　database")　=　"C:\Program　Files\Common　Files\System\SYSTEM.MDW"
cnn.Open　"Data　Source=\db2.mdb",　"matu",　"2",　adConnectUnspecified
cnn.Close
　　　　　　　　　
MsgBox　"成功"
　　　　　　　　　Exit　Sub
SOS:
MsgBox　Err.Description

End　Sub

'因みにVBからAccessのユザー、権限などを設定するには「ADOX」を使用します。
具体的にはMSDNライブラリで「SYSTEM．MDW」を検索してみて下さい。
サンプルコードもきちんと載っています。

二分探索アルゴルズム[VB]

完全な例はダウンロードコーナーからダウンロードできます。

Private　Function　BSearch(ByVal　kenmoji　As　String)　As　Long
'　バイナリ検索

Dim　FileNum　As　Integer
Dim　Position　As　Long
Dim　strR　As　yName　'ユーザー定義型　40バイト

Dim　stmoji　As　String

'　次に使用可能なファイル番号を取得します。
FileNum　=　FreeFile
Position　=　1

Dim　low　As　Long,　hei　As　Long
low　=　1
hei　=　47

'　ファイルを　Open　ステートメントで開きます。
Open　App.Path　&　"\都道府県1.dat"　For　Random　As　#FileNum　Len　=　Len(strR)
　
　
Do　Until　low　＞　hei
　　　Position　=　(low　+　hei)　/　2
　
　　　'データの読み込み
　　　Get　#FileNum,　Position,　strR
　　　
　　　'Debug.Print　strR.oneline
　　　Dim　stkana　As　String　'カタカナを入れる
　　　Dim　intIti　As　String　'数字を入れる
　　　
　　　Dim　ArryH()　As　String
　　　ArryH　=　Split(strR.oneline,　"　")
　　　stkana　=　ArryH(0)
　　　
　　　
　　　If　Left(stkana,　Len(kenmoji))　=　kenmoji　Then
　　　　'一致すれば
　　　
　　　　　　　　Dim　i　As　Integer
　　　　　　　　Do
　　　　　　　　　　　　　i　=　i　+　1
　　　　　　　　　　　　　intIti　=　ArryH(i)
　　　　　　　　Loop　Until　ArryH(i)　＜＞　""
　　　　　　　　Close　#FileNum
　　　　　　　　BSearch　=　intIti　'位置を返す
　　　　　　　　Exit　Function
　　　End　If
　　　
　　　If　Left(stkana,　Len(kenmoji))　＞　kenmoji　Then
　　　　　hei　=　Position　-　1
　　　Else
　　　　　low　=　Position　+　1
　　　End　If
Loop
　　　
Close　#FileNum
　　　　
BSearch　=　0　'見つからない

　　　　
End　Function

二分探索アルゴルズム[C]

C言語版で使用している「都道府県1.dat」「都道府県1.dat」ファイルはVBで作成したものです。ダウンロードコーナーのVB版の中に入っています。

#include　＜stdio.h＞
#include　＜string.h＞//strlenに必要
#include　＜stdlib.h＞//文字列を整数に変換して返す

/*最初の検索結果から位置情報を抜き出して返す関数*/
int　itinuki(char　*kekka);

int　main(void)
{
FILE　*fp;
int　stlen;//検索文字数
int　low　=0;
int　hei=49;
int　posi=0;//検索位置
char　str[100];//100文字
char　hstr[100];//検索した文字のうち、検索文字数ぶん入れる

fp=fopen("都道府県1.dat","rb");
if　(fp==NULL){
printf("ファイルを開けませんでした\n");
return　1;
}
else{
printf("ファイルをオープンしました。\n検索文字を入力してください\n");

int　ret=1;//比較した結果が入る
char　ken[10];
scanf("%s",ken);//検索文字を入力　　alt+半角/全角で日本語入力可能
stlen=strlen(ken);//検索文字の長さを取得
/*検索*/
while(low＜=hei){
posi=(low+hei)/2;
fseek(fp,posi*40,SEEK_SET);
　　　　fread(str,40,1,fp);
for　(int　i=0;i＜=stlen;i++){
hstr[i]=str[i];
}
hstr[i]='\0';//これを入れておかないと意味不明になる
ret=strncmp(ken,hstr,stlen);//検索したものと、比較
if(ret＜0){
hei=posi-1;
}else　if(ret＞0){
low=posi+1;
}else　if(ret==0){
//ヒットすれば表示する
printf("%s\n",str);
int　iti;
iti=itinuki(str);

FILE　*ofp;
char　strLast[100];
ofp=fopen("都道府県.dat","rb");
if　(ofp==NULL){
printf("ファイルを開けませんでした\n");
return　1;
}else{
iti--;//VBでの位置なので1つ引いておく。
fseek(ofp,iti*50,SEEK_SET);
fread(strLast,50,1,ofp);
printf("%s\n",strLast);
fclose(ofp);
}

fclose(fp);
return　0;
}
}　
printf("該当なし\n");
}

fclose(fp);
return　0;

}

int　itinuki(char　*kekka){
char　ret[100];
int　flg=3;
while(*kekka!='\0'){
if((*kekka=='　')　&&　(flg==3)){
flg=0;
}
if(((flg==0)　||　(flg==1))　&&　(*kekka!='　')){
ret[flg]=*kekka;
flg++;
}
*kekka++;
}
return　atoi(ret);//文字列を整数に変換して返す
}

ADO接続、DAO接続　クラスの基本

Option　Explicit

Private　rsDAO　As　DAO.Recordset
Private　wks　As　DAO.Workspace
Private　db　As　DAO.Database

Private　rsADO　As　ADODB.Recordset
Private　cone　As　ADODB.Connection
'ﾌﾟﾛﾊﾟﾃｨ値を保持するためのﾛｰｶﾙ変数。
Private　mvardbPath　As　String　'ﾛｰｶﾙ　ｺﾋﾟｰ
'ﾌﾟﾛﾊﾟﾃｨ値を保持するためのﾛｰｶﾙ変数。
Private　mvarAdoConeStr　As　String　'ﾛｰｶﾙ　ｺﾋﾟｰ

Public　Property　Let　AdoConeStr(ByVal　vData　As　String)
'ﾌﾟﾛﾊﾟﾃｨに値を代入するときに、代入式の左辺で使用します。
'Syntax:　X.AdoConeStr　=　5
　　　　mvarAdoConeStr　=　vData
End　Property

Public　Property　Get　AdoConeStr()　As　String
'ﾌﾟﾛﾊﾟﾃｨの値を取得するときに、代入式の右辺で使用します。
'Syntax:　Debug.Print　X.AdoConeStr
　　　　AdoConeStr　=　mvarAdoConeStr
End　Property

Public　Property　Let　dbPath(ByVal　vData　As　String)
'ﾌﾟﾛﾊﾟﾃｨに値を代入するときに、代入式の左辺で使用します。
'Syntax:　X.dbPath　=　5
　　　　mvardbPath　=　vData
End　Property

Public　Property　Get　dbPath()　As　String
'ﾌﾟﾛﾊﾟﾃｨの値を取得するときに、代入式の右辺で使用します。
'Syntax:　Debug.Print　X.dbPath
　　　　dbPath　=　mvardbPath
End　Property

Public　Function　DaoOpenRecordset(ByVal　strSQL　As　String)　As　DAO.Recordset
'レコードセットを返します

'　　　　　Jet　ワークスペース
'　　　　　Jet　データベース接続を開きます｡
　　　　Set　wks　=　CreateWorkspace("ma",　"admin",　"",　dbUseJet)
　　　
　　　　
　　　　Dim　prpLoop　As　Property
　　　　
　　　　With　wks
　　　　　　　　'　Jet　ワークスペースの
　　　　　　　　'　Properties　コレクションを列挙します。
　　　　　　　　Debug.Print　_
　　　　　　　　　　　　"Properties　of　unnamed　Microsoft　Jet　workspace"
　　　　　　　　On　Error　Resume　Next
　　　　　　　　For　Each　prpLoop　In　.Properties
　　　　　　　　　　　　Debug.Print　"　　　　"　&　prpLoop.Name　&　"　=　"　&　prpLoop
　　　　　　　　Next　prpLoop
　　　　　　　　On　Error　GoTo　0
　　　　End　With
　　　　
　　　
　　　　Set　db　=　wks.OpenDatabase(mvardbPath)
　　　　Set　rsDAO　=　db.OpenRecordset(strSQL,　dbOpenDynaset)
　　　　If　rsDAO.EOF　=　False　Then
　　　　　　　rsDAO.MoveLast
　　　　　　　rsDAO.MoveFirst
　　　　End　If
　　　　Set　DaoOpenRecordset　=　rsDAO
　　　　
End　Function

Public　Function　ADOOpenRecordset(ByVal　strSQL　As　String)　As　ADODB.Recordset

　　　　Set　cone　=　New　ADODB.Connection
'　　　　Debug.Print　mvarAdoConeStr
　　　　cone.ConnectionString　=　mvarAdoConeStr
　　　　cone.Open
　　　　Set　rsADO　=　New　ADODB.Recordset
　　　　rsADO.Open　strSQL,　cone,　adOpenStatic,　adLockOptimistic
　　　　　　　Set　ADOOpenRecordset　=　rsADO
End　Function

Private　Sub　Class_Terminate()
On　Error　Resume　Next

　　　　　　　　rsDAO.Close
　　　　　　　　Set　rsDAO　=　Nothing
　　　　　　　　db.Close
　　　　　　　　Set　db　=　Nothing
　　　　　　　　wks.Close
　　　　　　　　Set　wks　=　Nothing
　　　　　　　　
　　　　　　　　rsADO.Close
　　　　　　　　Set　rsADO　=　Nothing
　　　　　　　　cone.Close
　　　　　　　　Set　cone　=　Nothing
End　Sub

データグリッドでの改行

Private　Sub　Command3_Click()
'ADOでデータベースに接続、検索する
'[プロジェクト]-[参照設定]でMicrosoft　ActiveX　2.6を参照する
'サンプルのDBは[NWIND.MDB]の中の[Customers]テーブルを[db1.mdb]にインポートして使用

Dim　rs　As　ADODB.Recordset
Dim　cn　As　ADODB.Connection

Dim　str　As　String

'インスタンスを作成する
'NewとSetについてはここを参照して下さい。
'http://www7.big.or.jp/~pinball/discus/vb/56108.html
Set　cn　=　New　ADODB.Connection

cn.CursorLocation　=　adUseClient　　'これを書かないとデータグリッドに放り込めません
cn.ConnectionString　=　"Provider=Microsoft.Jet.OLEDB.4.0;"　&　_
　　　　　　　　　　　　　"Data　Source="　&　App.Path　&　"\db1.mdb;"
'コネクションを開いておいて
cn.Open

''こちらもコメントをはずして実行してみてください
'レコードセットを取得します　こちらの場合はデータグリッドの設定はほとんど必要なし
'レコードセットを返さない時にもExecuteは使えます｡削除､更新など　とても便利です｡
'Set　rs　=　cn.Execute("SELECT　*　FROM　Customers",　,　adCmdText)

'DBに改行された言葉があたらそのまま表示するには　例えば...
Set　rs　=　cn.Execute("SELECT　CustomerID,CompanyName,Country　FROM　Customers",　,　adCmdText)

'フィルター
rs.Filter　=　"Country　=　'UK'"

'レコードセットから文字列として取得
str　=　rs.GetString(adClipString)

'一発で保存する
Open　App.Path　&　"\Test.xls"　For　Output　As　#1
　　　　　　Print　#1,　str
Close　#1

'行を付け足して
DataGrid1.Columns.Add　(2)

'DBで改行　されている場合、改行されたまま表示するには
'データグリッドでの改行表示の場合はこれを書く
'Accessでフィールド内に改行を入れるには[Ctrl]+[Enter]
'Excelでは[Alt]+[Enter]で改行できます
DataGrid1.Columns(0).Caption　=　"CustomerID"
DataGrid1.Columns(0).WrapText　=　True
DataGrid1.Columns(0).DataField　=　"CustomerID"
DataGrid1.Columns(1).Caption　=　"CompanyName"
DataGrid1.Columns(1).WrapText　=　True
DataGrid1.Columns(1).DataField　=　"CompanyName"
DataGrid1.Columns(2).Caption　=　"Country"
DataGrid1.Columns(2).WrapText　=　True
DataGrid1.Columns(2).DataField　=　"Country"

'データグリッドに表示
Set　DataGrid1.DataSource　=　rs

'パフォーマンス　速度チェックには以下のAPIを使用する
Dim　X,　ti
ti　=　timeGetTime

'リストビューに表示する
ListView1.ListItems.Clear

Dim　myli　As　ListItem
Do　Until　rs.EOF
　　　　
　　　　Set　myli　=　ListView1.ListItems.Add()
　　　　myli.Text　=　rs.Fields(0).Value
　　　　myli.SubItems(1)　=　rs.Fields(1).Value
　　　　rs.MoveNext

Loop

ti　=　timeGetTime　-　ti
Debug.Print　ti

'作成したインスタンスを削除します　ここで削除するとデータグリッドの表示が消える
'変数をフォームレベルにあげれば問題なし　インスタンスの削除は必要な時に行う。
'rs.Close
'Set　rs　=　Nothing
'cn.Close
'Set　cn　=　Nothing

End　Sub

VB Tips And Sample（HOME）