三流君 ＶＢＡで楽しくプログラミング(Excel/Access VBAの解説/サンプルです)
[VBA系のバックナンバー]
[VBA系 TOP]
[三流君 TOP]
＜歌詞の表記を参考に関数を作成＞
こんにちは、三流プログラマーＫｅｎ３です。
今回は、
関数のまとめ方、歌詞の表記を参考に
を少し書きます。
気楽に読んでください。
/*
* １．大きなのっぽの古時計
*/
大きなのっぽの古時計 おじいさんの時
百年いつも動いてた ご自慢の時計さ
おじいさんの生まれた朝に買ってきた時計さ
いまはもう動かない その時計
（＊）百年休まずに
チクタクチクタク
おじいさんといっしょに
チクタクチクタク
いまはもう動かない
その時計
なんでも知ってる古時計 おじいさんの時
きれいな花嫁やってきた その日も動いてた
うれしいこともかなしいことも みな知ってる時計さ
いまはもう動かない その時計
（＊）繰り返し
真夜中にベルがなった おじいさんの時
お別れのときがきたのを みなにおしえたのさ
天国へ昇るおじいさん 時計ともおわかれ
いまはもう動かない その時計
（＊）繰り返し
有名な歌ですよね、私でも知ってます。
最近、みなさんは、どんな歌聞いてますか？
心が落ち着く歌あったら、教えてください、
また、キーボードをノリノリで打てる歌、プログラミング中にお進めの歌など、
掲示板に書いてくれると、うれしいです。
何がいいたいんだよ、オマエは。
あっ、忘れてた。
歌詞の書き方、表現の仕方、
（＊）繰り返し
^^^^^^^^^^^^^^^
と同じサビの部分を書いてます。
プログラムも同様にまとめられる部分はまとめましょうよ。ってことで、
/*
* ２．前、作成したExcel画像管理サンプルを修正する
*/
Excelで画像管理のサンプル、Formの作成を
In message "[VBAで楽しく No.042] - ExcelのForm シートと連動させる",
http://www.ken3.org/backno/backno_vba09.html#42
でやりました。サンプルファイルは、
http://www.ken3.org/vba/lzh/vba042.lzh
にtest042-book.xlsが保存されています。
まぁ、問題ありのプログラムなんだけど、
今回は、同一処理を関数化してまとめてみたいと思います。
下記、問題のソースファイルです(長いよ)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim yCNT As Integer '行カウンター
Private Sub btnNEXT_Click()
Dim strFNAME As String 'ファイル名作成用
'次の位置を計算
yCNT = yCNT + 1 '行カウンタを増やす
'セルの値をフォームのテキストボックスに代入する
txtTITLE = Sheets("DATA").Cells(yCNT, "A")
txtFILENAME = Sheets("DATA").Cells(yCNT, "B")
txtMEMO = Sheets("DATA").Cells(yCNT, "C")
'画像ファイルを表示する
If Trim(txtFILENAME) = "" Then 'ファイル名が入力されているかチェック
imgBOX.Picture = LoadPicture("") '画像を消す
Exit Sub
End If
strFNAME = Sheets("DATA").Range("E1") & txtFILENAME 'ファイル名を作成
If Dir(strFNAME) = "" Then 'ファイルが存在するかチェック
'存在していない時
imgBOX.Picture = LoadPicture("") '画像を消す
Else
imgBOX.Picture = LoadPicture(strFNAME) 'ファイル名をセット
End If
End Sub
Private Sub btnPREV_Click()
Dim strFNAME As String 'ファイル名作成用
'前の位置を計算
yCNT = yCNT - 1 '行カウンタを減らす
'セルの値をフォームのテキストボックスに代入する
txtTITLE = Sheets("DATA").Cells(yCNT, "A")
txtFILENAME = Sheets("DATA").Cells(yCNT, "B")
txtMEMO = Sheets("DATA").Cells(yCNT, "C")
'画像ファイルを表示する
If Trim(txtFILENAME) = "" Then 'ファイル名が入力されているかチェック
imgBOX.Picture = LoadPicture("") '画像を消す
Exit Sub
End If
strFNAME = Sheets("DATA").Range("E1") & txtFILENAME 'ファイル名を作成
If Dir(strFNAME) = "" Then 'ファイルが存在するかチェック
'存在していない時
imgBOX.Picture = LoadPicture("") '画像を消す
Else
imgBOX.Picture = LoadPicture(strFNAME) 'ファイル名をセット
End If
End Sub
Private Sub txtFILENAME_Change()
'テキストボックスの値をシートへ代入
Sheets("DATA").Cells(yCNT, "B") = txtFILENAME
'画像ファイル名が変更されたので、画像の処理を行う
If Trim(txtFILENAME) = "" Then 'ファイル名が入力されているかチェック
imgBOX.Picture = LoadPicture("") '画像を消す
Exit Sub
End If
strFNAME = Sheets("DATA").Range("E1") & txtFILENAME 'ファイル名を作成
If Dir(strFNAME) = "" Then 'ファイルが存在するかチェック
'存在していない時
imgBOX.Picture = LoadPicture("") '画像を消す
Else
imgBOX.Picture = LoadPicture(strFNAME) 'ファイル名をセット
End If
End Sub
Private Sub txtMEMO_Change()
'テキストボックスの値をシートへ代入
Sheets("DATA").Cells(yCNT, "C") = txtMEMO
End Sub
Private Sub txtTITLE_Change()
'テキストボックスの値をシートへ代入
Sheets("DATA").Cells(yCNT, "A") = txtTITLE
End Sub
Private Sub UserForm_Initialize()
'ディレクトリが入って無い時、ブックのパスを代入
If Len(Sheets("DATA").Range("E1")) = 0 Then
Sheets("DATA").Range("E1") = ThisWorkbook.Path & "\"
End If
Dim strFNAME As String 'ファイル名作成用
'初期処理
yCNT = 2 '初期値の２行目を代入
'セルの値をフォームのテキストボックスに代入する
txtTITLE = Sheets("DATA").Cells(yCNT, "A")
txtFILENAME = Sheets("DATA").Cells(yCNT, "B")
txtMEMO = Sheets("DATA").Cells(yCNT, "C")
'画像ファイルを表示する
If Trim(txtFILENAME) = "" Then 'ファイル名が入力されているかチェック
imgBOX.Picture = LoadPicture("") '画像を消す
Exit Sub
End If
strFNAME = Sheets("DATA").Range("E1") & txtFILENAME 'ファイル名を作成
If Dir(strFNAME) = "" Then 'ファイルが存在するかチェック
'存在していない時
imgBOX.Picture = LoadPicture("") '画像を消す
Else
imgBOX.Picture = LoadPicture(strFNAME) 'ファイル名をセット
End If
End Sub
うわ、ダラダラと長いよね
^^^^^^^^^^^^^^
恥ずかしく無いの？よく人前に出せたよね。。。こんなの（笑）
/*
* ３．よく見ると、同じような処理が、、、、
*/
よく見ると、
セルの値を代入している処理
'セルの値をフォームのテキストボックスに代入する
txtTITLE = Sheets("DATA").Cells(yCNT, "A")
txtFILENAME = Sheets("DATA").Cells(yCNT, "B")
txtMEMO = Sheets("DATA").Cells(yCNT, "C")
と
画像ファイルの表示処理
'画像ファイルを表示する
If Trim(txtFILENAME) = "" Then 'ファイル名が入力されているかチェック
imgBOX.Picture = LoadPicture("") '画像を消す
Exit Sub
End If
strFNAME = Sheets("DATA").Range("E1") & txtFILENAME 'ファイル名を作成
If Dir(strFNAME) = "" Then 'ファイルが存在するかチェック
'存在していない時
imgBOX.Picture = LoadPicture("") '画像を消す
Else
imgBOX.Picture = LoadPicture(strFNAME) 'ファイル名をセット
End If
が
同じことに気が付くと思います。
~~~~~~~~~~~~~~~~~~
これを、歌詞の表記(＊)のようにまとめたいと思います。
Sub SheetToForm() 'セルの値をフォームのテキストボックスに代入する
txtTITLE = Sheets("DATA").Cells(yCNT, "A")
txtFILENAME = Sheets("DATA").Cells(yCNT, "B")
txtMEMO = Sheets("DATA").Cells(yCNT, "C")
End Sub
Sub PUTPicture() '画像ファイルを表示する
Dim strFNAME As String 'ファイル名作成用
If Trim(txtFILENAME) = "" Then 'ファイル名が入力されているかチェック
imgBOX.Picture = LoadPicture("") '画像を消す
Exit Sub
End If
strFNAME = Sheets("DATA").Range("E1") & txtFILENAME 'ファイル名を作成
If Dir(strFNAME) = "" Then 'ファイルが存在するかチェック
'存在していない時
imgBOX.Picture = LoadPicture("") '画像を消す
Else
imgBOX.Picture = LoadPicture(strFNAME) 'ファイル名をセット
End If
End Sub
とSub関数化して、
Call PUTPicture
Call SheetToForm
で呼んでみます。
下記、修正後のソースファイルです。
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim yCNT As Integer '行カウンター
Private Sub btnNEXT_Click()
'次の位置を計算
yCNT = yCNT + 1 '行カウンタを増やす
'セルの値をフォームのテキストボックスに代入する
Call SheetToForm
'画像ファイルを表示する
Call PUTPicture
End Sub
Private Sub btnPREV_Click()
'前の位置を計算
yCNT = yCNT - 1 '行カウンタを減らす
'セルの値をフォームのテキストボックスに代入する
Call SheetToForm
'画像ファイルを表示する
Call PUTPicture
End Sub
Private Sub txtFILENAME_Change()
'テキストボックスの値をシートへ代入
Sheets("DATA").Cells(yCNT, "B") = txtFILENAME
'画像ファイル名が変更されたので、画像の処理を行う
Call PUTPicture
End Sub
Private Sub txtMEMO_Change()
'テキストボックスの値をシートへ代入
Sheets("DATA").Cells(yCNT, "C") = txtMEMO
End Sub
Private Sub txtTITLE_Change()
'テキストボックスの値をシートへ代入
Sheets("DATA").Cells(yCNT, "A") = txtTITLE
End Sub
Private Sub UserForm_Initialize()
'ディレクトリが入って無い時、ブックのパスを代入
If Len(Sheets("DATA").Range("E1")) = 0 Then
Sheets("DATA").Range("E1") = ThisWorkbook.Path & "\"
End If
'初期処理
yCNT = 2 '初期値の２行目を代入
'セルの値をフォームのテキストボックスに代入する
Call SheetToForm
'画像ファイルを表示する
Call PUTPicture
End Sub
Sub SheetToForm() 'セルの値をフォームのテキストボックスに代入する
txtTITLE = Sheets("DATA").Cells(yCNT, "A")
txtFILENAME = Sheets("DATA").Cells(yCNT, "B")
txtMEMO = Sheets("DATA").Cells(yCNT, "C")
End Sub
Sub PUTPicture() '画像ファイルを表示する
Dim strFNAME As String 'ファイル名作成用
If Trim(txtFILENAME) = "" Then 'ファイル名が入力されているかチェック
imgBOX.Picture = LoadPicture("") '画像を消す
Exit Sub
End If
strFNAME = Sheets("DATA").Range("E1") & txtFILENAME 'ファイル名を作成
If Dir(strFNAME) = "" Then 'ファイルが存在するかチェック
'存在していない時
imgBOX.Picture = LoadPicture("") '画像を消す
Else
imgBOX.Picture = LoadPicture(strFNAME) 'ファイル名をセット
End If
End Sub
やっと、スッキリしたよね。
プログラム、プログラムってのは、、関数化と偉そうに言ってるけど、
歌詞の表記と同様に、同じ処理をまとめただけでした。
まぁ、これもひとつの書き方で、
プログラムらしいってのは、まだまだあって、
パラメーターを受け取って仕事をする関数
や
仕事をして結果を返す関数
など、
組み合わせてスッキリしたプログラムを書きましょう（説明して行きます）
In message "[VBAで楽しく No.024] - 関数のパターンを少し",
http://www.ken3.org/backno/backno_vba05.html#24
でも軽く書いてます、合わせて見て笑ってください。
（この説明の時、歌詞の例題を思いつかなかった）
/*
* ４.おわりの挨拶
*/
今回は、
・音楽は何が好きですか？
・関数化して、同じ処理をまとめる
でした。
修正した、Excelで画像管理サンプルを
サンプルファイルは、
http://www.ken3.org/vba/lzh/vba045.lzh
にtest045-book.xlsが保存されています。
何か素朴な疑問などあったら、メール、掲示板に気軽に書いてください。
拾い読みして、
１つでも何かの参考となれば幸いです。
Ｅｘｃｅｌ／Ａｃｃｅｓｓ大好き、三流プログラマーＫｅｎ３でした。
＜カウンタで先頭行チェック、空白で終わりの判断＞
こんにちは、三流プログラマーＫｅｎ３です。
今回は、
前回作成した、シートとExcel Formのデータやり取りで、
ボタンを押しつづけるとエラーが発生してしまう、
そんなバグ（プログラムの欠陥、穴）を修正してみたいと思います。
気楽に読んでください。
/*
* １．わかり易い欠陥、エラー出ないけど防ぎたい欠陥
*/
Excelで画像管理のサンプル、Formの作成を
In message "[VBAで楽しく No.042] - ExcelのForm シートと連動させる",
http://www.ken3.org/backno/backno_vba09.html#42
でやりました。
http://www.ken3.org/vba/lzh/vba045.lzhで、関数をまとめました。
まぁ、問題ありのプログラムで、
In message "[VBAで楽しく No.042] - ExcelのForm シートと連動させる",
>・前のボタンを押しつづけるとエラー（そんなの本文で一言も書いてないよ）
>・次のボタンを最終データ以降も押せる（そんなの本文で一言もフレテナイよ）
本人も、そんなこと書きつつ、欠陥品をそのまま世に出しつづけてます。
もう、わかり易い欠陥で、
・前のボタンを押しつづけるとエラーは、
最悪のレベル、実行時エラーで止まるですね。
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
エラー画面
発生場所
内容は、みてわかるように、前のボタンを押してカウンターが０になり、
０行目を参照にしようとムチャして、実行時エラーが発生。
まったく、テストやってんの？アンタ？的エラーですね。
・次のボタンを最終データ以降も押せる
は
まだ、かわいいほうで、実行時エラーは出ないんだけど、
空白行をドンドン進めて、
論理的におかしいと感じるエラーかなぁ。
Accessで作った画像管理のサンプルは、
( 詳細はhttp://www.ken3.org/backno/backno_vba09.html#41参照)
In message "[VBAで楽しく No.041] - AccessのForm .Pictureプロパティで画像参照",
>・Accessフォームをウィザードで作る
>・.Pictureで画像の管理
---
Accessのテーブルを元にしたフォームで、
データ数分しか移動しないので、なんのチェックもいらなかったんですね。
＊勝手にＡｃｃｅｓｓ君がチェックしてるので。
今回は自分で（プログラムで）
Excelのシートとフォームを連動（データのセット／参照）させているので、
自分でチェックしないとね。
＊そう考えると、Ａｃｃｅｓｓってよく出来てるのかなぁ。
Excelにもセル範囲との連動した自動フォーム作成あればいいのにね。
/*
* ２．前ボタンの対策（チェック）
*/
さてと、問題の部分は、
Private Sub btnPREV_Click()
'前の位置を計算
yCNT = yCNT - 1 '行カウンタを減らす
'セルの値をフォームのテキストボックスに代入する
Call SheetToForm
'画像ファイルを表示する
Call PUTPicture
End Sub
かぁ、
yCNT = yCNT - 1
ダメだよね、無条件に計算してちゃね。
チェックを入れますか、えっと、見出しが１行目だから、
２行目からデータ、カウンタが２の時は減らさないようにしたいから、
If yCNT = 2 Then Exit Sub
のチェックを入れて、何もしなくていいや。
Private Sub btnPREV_Click()
'カウンタをチェックして、先頭なら何もしない vba046で追加
If yCNT = 2 Then Exit Sub
'前の位置を計算
yCNT = yCNT - 1 '行カウンタを減らす
'セルの値をフォームのテキストボックスに代入する
Call SheetToForm
'画像ファイルを表示する
Call PUTPicture
End Sub
なんだぁ、この１行でよかったの？
yCNT = 2 だったら、Exit Subで関数を終わらせてるだけですね。
Exit Subの解説は、
~~~~~~~~
[No.19 Exit Subで途中退場する]
http://www.ken3.org/backno/backno_vba04.html#19
を見てください（みなくても処理の感覚はわかりましたよね）
/*
* ３．次ボタン、最終データの判断
*/
お次は、空白行でも気にしないで進めてしまうってヤツですね。
エラー発生しないから、ほっといても良いんだけどね。
Private Sub btnNEXT_Click()
'次の位置を計算
yCNT = yCNT + 1 '行カウンタを増やす
'セルの値をフォームのテキストボックスに代入する
Call SheetToForm
'画像ファイルを表示する
Call PUTPicture
End Sub
ここも、ノーチェックだから、
今居る行のデータが無い時は、次に進まなくしたいので、チェックを入れます。
If Cells(yCNT, "A") = "" And Cells(yCNT, "B") = "" And Cells(yCNT, "C") = "" Then
Exit Sub '全ての項目入っていなかったら、処理を抜ける
End If
と少しバカっぽいけど、こんな感じでチェックを入れてと、
Private Sub btnNEXT_Click()
'データが入っているかチェックする
If Cells(yCNT, "A") = "" And Cells(yCNT, "B") = "" And Cells(yCNT, "C") = "" Then
Exit Sub '全ての項目入っていなかったら、処理を抜ける
End If
'次の位置を計算
yCNT = yCNT + 1 '行カウンタを増やす
'セルの値をフォームのテキストボックスに代入する
Call SheetToForm
'画像ファイルを表示する
Call PUTPicture
End Sub
に修正したら、なんとか動いたかなぁ。
＊現在位置（行カウンタ）を表示してないので、わかりにくいけど、
次を押し続けて、戻ったらテストはＯＫでした。
/*
* ４.おわりの挨拶
*/
今回は、
・わかり易い欠陥、エラー出ないけど防ぎたい欠陥
・カウンタの値をチェック先頭なら処理しない
・データをチェックして、空白なら次に移動しない
でした。
修正した、Excelで画像管理サンプルを
サンプルファイルは、
http://www.ken3.org/vba/lzh/vba046.lzh
にtest046-book.xlsが保存されています。
まっ、いろいろと不親切なフォームだけどね。（このへんは次回以降に）
あっ、グローバル変数の説明、まだしてないや。。。
何か素朴な疑問などあったら、メール、掲示板に気軽に書いてください。
拾い読みして、
１つでも何かの参考となれば幸いです。
Ｅｘｃｅｌ／Ａｃｃｅｓｓ大好き、三流プログラマーＫｅｎ３でした。
＜Excel Application.GetOpenFilenameでファイル名取得＞
こんにちは、三流プログラマーＫｅｎ３です。
今回は、
ファイル名を取りたくて、
Application.GetOpenFilename
を使ってみます。
気楽に読んでください。
サンプルファイルは、
http://www.ken3.org/vba/lzh/vba047.lzh
にtest047-book.xls, db047.mdbが保存されています。(Excel97,Access97)
/*
* １．みんな好きだねぇ画像処理、デジカメとかスキャナーの普及？
*/
画像処理関係が質問のトップかなぁ今。
（みんな内気？で掲示板に書いてくれないけど）
デジカメとかスキャナーの普及？
でデジタル画像を処理する（処理したい）場面が増えたんでしょうね（と勝手な予測）
下記の質問メールをもらう。
In message "Accessでの画像ファイル処理について",
m*****@k*****さん wrote...
>画像の保存先を指定したあと、画像リストのテーブルを作成しないで
>ファイル名を指定するだけで保存先に見に行かせたいです。
>または
>ファイル選択ダイアログを表示させたいですぅ〜。
> ↑
>これだと本格的にＶＢが必要ですか？
---
なるほどね、ファイル名入力じゃなく、選ばせたいのかぁ。
ＶＢが無い環境でできたらやりますか。
＊ＶＢ使えばなんでもできるってイメージあるのかなぁ？
あっ、逆にＶＢ使わないとなんにも出来ないってイメージかな。
In message "Accessでの画像ファイル処理について",
m*****@k*****さん wrote...
>それから
>あつかましいのですが…
>もうひとつ質問がありますです。f(^^;
>
>フォームの画面を印刷させたいのですが
>フォームをメイン＋サブで作成しているとメイン画面内容の
>フォーム印刷は出来るのですが
>サブのデータ内容がプレビューでも表示されず印刷も出来ません。(T◇T)
> （メイン＋サブ＝1枚目のデータは印刷可能）
>2枚目以降はサブのデータ内容がついてきません。
>フォーム印刷はメインだけしか無理なのでしょうか？
---
レポート作らないで、フォーム画面からの印刷は、そんな感じだと思います。
＊読者の皆さんの中で、なにか小技でかわした？とかテクあったら教えてください。
In message "Accessでの画像ファイル処理について",
m*****@k*****さん wrote...
>以上２点の質問なのですが
>回答を頂けると大変うれしいのですが…
>なにとぞ
>未熟者（半熟者）ですので
>ご教授おねがいいたしますです。m(__)m
---
う〜ん、ご教授かぁ、（ネットの世界では、流行語なのかなぁ？）
私の性格を知らない読者ですね（そんなの知ってるわけねぇダロ）
ご教授って言葉、嫌いなんだよねナゼカ。
そんなたいした回答できないのもあるけど、
なんかそんなんで持ち上げられて回答するのもねぇ。
処理ができて、質問者がうれしくてお礼のメールは好きだけど、
回答前にそんなにm(__)mと頭下げなくても。。。
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
私宛のメールは、気軽に送ってくださいね。
＊あっ、お礼のメールはいらないですよ、
便りの無いのは良い知らせって感じで、問題あったら下さいね。
/*
* ２．Excelには、Application.GetOpenFilenameがあります
*/
Excelには、
Application.GetOpenFilename
なんて、いいものがあります。
使い方は簡単で、
Sub test047()
Dim strFNAME As String 'ファイル名
strFNAME = Application.GetOpenFilename("画像 ,*.jpg; *.gif; *.bmp")
MsgBox "選択されたファイル名は" & strFNAME
End Sub
ここでは、画像のファイルを取りたいので、
"画像 ,*.jpg; *.gif; *.bmp"
と、ファイルの種類を渡しています（省略すると*.*）
jpgのみ場合は、"画像 ,*.jpg"でＯＫです。
カンマの前がタイトル、次がワイルドカード指定となってます。
＊複数の時はセミコロンで区切る。
ここで、気になるのが選択しないで、キャンセルを押された時。
文字列Falseが返ってくるみたいです。
/*
* ３．Accessに無いので、小細工
*/
Excelには、
Application.GetOpenFilename
なんて、いいものがあります。
って書いてたよね。
はい。
日本語理解すると、Accessには、いいものは無いの？
ええ、残念ながら私が探した範囲では、、、（ホントはあるかも、要チェックです）
なので、今回、小細工させていただきます。
AccessからExcelを起動するのは、いろいろとやりました。
In message "[VBAで楽しく No.002] - AccessからExcel出力",
/vba/backno/vba002.html
で、
Dim oApp As Object
Set oApp = CreateObject("Excel.Application")
oApp.Visible = True
oApp.UserControl = True
なんて、
CreateObject("Excel.Application")
を使って、書いてましたね。
流用して、
Private Sub btnExcelを開く_Click()
Dim oApp As Object
Set oApp = CreateObject("Excel.Application")
oApp.Visible = True
oApp.UserControl = True
Dim strFNAME As String 'ファイル名
strFNAME = oApp.Application.GetOpenFilename("画像 ,*.jpg; *.gif; *.bmp")
MsgBox "選択されたファイル名は" & strFNAME
End Sub
と作ってみました。
実行してみると、まぁ選択できたけど、選択後Ｅｘｃｅｌが居座ってるよ。
サヨナラしてもらいたいし、出来たら顔も見せてほしくないよね。
↑働いてるＥｘｃｅｌに対して、なんて失礼な言い方なんだろう。
Excelファンが怒るよキット（うそです）
.Visible = False にして、可視を不可視に、
.Quit でアプリを抜けてサヨナラします。
Private Sub btn裏で工作する_Click()
Dim oApp As Object
Set oApp = CreateObject("Excel.Application") 'Excelのオブジェクトを作成
oApp.Visible = False '見えなくする、裏工作したいので
oApp.UserControl = True
Dim strFNAME As String 'ファイル名
strFNAME = oApp.Application.GetOpenFilename("画像 ,*.jpg; *.gif; *.bmp")
oApp.Quit '任務完了、サヨナラする
Set oApp = Nothing 'オブジェクトも解放
MsgBox "選択されたファイル名は" & strFNAME
End Sub
って感じで。
/*
* ４．Access画像処理に組み込む
*/
さてと、ダイアログ開く前にＥｘｃｅｌが起動するから、
遅いんだけど（私のマシーンではチョット一呼吸かかる）
なんとかできた。
これを
In message "[VBAで楽しく No.041] - AccessのForm .Pictureプロパティで画像参照",
http://www.ken3.org/backno/backno_vba09.html#41
のdb041.mdbに組み込みます。
画像フォルダーの処理を、絶対パスの固定フォルダーに置換えます。
画像ファイル名入力の隣に、ボタンを作って、
サンプルファイルは、
http://www.ken3.org/vba/lzh/vba047.lzh
にtest047-book.xls, db047.mdbが保存されています。
(Excel97,Access97)みて、笑ってください。
Private Sub btn画像選択_Click()
Dim oApp As Object
Set oApp = CreateObject("Excel.Application") 'Excelのオブジェクトを作成
oApp.Visible = False '見えなくする、裏工作したいので
oApp.UserControl = True
Dim strFNAME As String 'ファイル名
strFNAME = oApp.Application.GetOpenFilename("画像 ,*.jpg; *.gif; *.bmp")
oApp.Quit '任務完了、サヨナラする
Set oApp = Nothing 'オブジェクトも解放
If strFNAME <> "False" Then 'キャンセルかもしれないのでチェック
Me![F_GFILENAME] = strFNAME '選択されたファイル名をセットする
Call PUTGraph '画像表示を呼ぶ
End If
End Sub
Private Sub F_GFILENAME_AfterUpdate() '画像ファイル入力後
Call PUTGraph '画像表示の関数を呼ぶ
End Sub
Private Sub Form_Current() 'レコードが移動したら
Call PUTGraph '画像表示の関数を呼ぶ
End Sub
Sub PUTGraph()
Dim strFNAME As String '画像ファイル名
'ファイル名入力済みかチェック(新規、未入力、クリアを考慮する)
If Len(Me![F_GFILENAME] & "") = 0 Then
Me![画像].Picture = ""
Exit Sub 'ここから後ろは処理しないので抜ける
End If
'ファイル名フルパスを作成
strFNAME = Me![F_GFILENAME]
'ファイルの存在をチェックする
If Dir(strFNAME) = "" Then
Me![画像].Picture = "" 'ファイルが見つからないので画像は無しにする
Else
Me![画像].Picture = strFNAME '画像ファイル名をセットする
End If
End Sub
まぁ、なんとかできたのかなぁ。。。
意地でＡＰＩを使わなかったけど、これでよかったのか、、、、
/*
* ５.おわりの挨拶
*/
今回は、
・画像管理、みんな好きですね
・Excel Application.GetOpenFilenameでファイル選択
・小細工 Excelで裏工作する方法
でした。
まっ、いろいろと不親切なサンプルだけどね。（このへんは次回以降に）
積み残し多いや。
何か素朴な疑問などあったら、メール、掲示板に気軽に書いてください。
拾い読みして、
１つでも何かの参考となれば幸いです。
Ｅｘｃｅｌ／Ａｃｃｅｓｓ大好き、三流プログラマーＫｅｎ３でした。
＜AccessからExcelブックを開き、書式設定を行う＞
こんにちは、三流プログラマーＫｅｎ３です。
今回は、
AccessからExcelブックを開き、書式設定を行ってみたいと思います
気楽に読んでください。
サンプルファイルは、
http://www.ken3.org/vba/lzh/vba048.lzh
にtest048-book.xls, db048.mdbが保存されています。
(Excel97,Access97)
/*
* １．もう一つあった、みんな大好きな処理
*/
>画像処理関係が質問のトップかなぁ今。
>（みんな内気？で掲示板に書いてくれないけど）
なんて前回ボソっといってたら、下記の書き込みがあった。
In message "[BBS :44] AccessVBAからExcelの書式を設定する方法",
>投稿時間：2003/01/17(Fri) 11:45
>
>おなまえ：アキコ
>タイトル：AccessVBAからExcelの書式を設定する方法
>コメント：
>
>はじめまして。アキコと申します。
>
>Access97VBAからExcelファイルを開いて
>書式を設定する方法を教えて下さい。
>
>2002/08/20のバックナンバーを参考に作ってみたのですが、
>「実行エラー'1004'
> RangeクラスのNumberFormatプロパティを設定できません」
>というエラーが出ます。
>この場合、どうすればよいのでしょうか？
>
>よろしくお願いします。
----
チョット気になる名前だったので、全文載せてみました。
Ｋｅｎ３が気になる名前は、チエちゃん、ミキちゃんとか、、いっぱいあるけど（笑）
なんて話は、置いといて、（女性だと質問掲示板でやさしくされるのでは？）
画像処理の次に質問多いのが、
AccessからExcelを操作する処理です。
~~~~~~~~~~~~~~~
昔のサンプル、
＜Access97からExcel形式へExport時に書式設定を行いたい＞
http://www.ken3.org/backno/hosoku/e025/index.html
で、少し解説してたけど、
ポイントは、
Excelのオブジェクトの参照方法
と
書式設定のプロパティ操作だと思います。
今回は、私の方法を含めて、書いてみます。
/*
* ２．AccessからExcelを起動する（Objectを作成、操作）
*/
AccessからExcelを起動するのは、いろいろとやりました。
In message "[VBAで楽しく No.002] - AccessからExcel出力",
/vba/backno/vba002.html
で、
Dim oApp As Object
Set oApp = CreateObject("Excel.Application")
oApp.Visible = True
oApp.UserControl = True
なんて、
CreateObject("Excel.Application")
を使って、書いてましたね。
ボタンを１つ作り、まず、起動させます。
変数名、objEXCELに変えました。
Private Sub btn起動_Click()
Dim objEXCEL As Object 'Excelを参照するためのオブジェクト
Set objEXCEL = CreateObject("Excel.Application") 'オブジェクト作成
objEXCEL.Visible = True '見えるようにする
objEXCEL.UserControl = True 'ユーザーの操作をＯＫにする
End Sub
これで、Ｅｘｃｅｌが起動することを確認します。
/*
* ３．次は得意のマクロ記録でオブジェクト操作（プロパティ、メソッド）を探る
*/
次に、新規作成でブックを作成します。
＊捨てるので保存しなくてＯＫです。
得意のマクロ記録で、やりたい操作を記録します。
>＜プロパティ、メソッドの探り方＞
>http://www.ken3.org/vba/excel-help.html
に、マクロ記録について少し書いてます、あわせて見てください。
ブックを開く操作とカンマ区切りの書式設定を記録します。
下記が記録されたマクロです。
Sub Macro1()
ChDir "D:\VBA-TEST"
Workbooks.Open FileName:="D:\VBA-TEST\Test048-Book.xls"
Columns("D:D").Select
Selection.Style = "Comma [0]"
End Sub
自分が行った操作と比べると、なんとなく、わかると思います。
/*
* ４．Accessのモジュールに組み込む
*/
で、これを実際組み込むには、
単純に頭にExcel参照用に作ったobjEXCELを付けます。
Private Sub btn起動_Click()
Dim objEXCEL As Object 'Excelを参照するためのオブジェクト
Set objEXCEL = CreateObject("Excel.Application") 'オブジェクト作成
objEXCEL.Visible = True '見えるようにする
objEXCEL.UserControl = True 'ユーザーの操作をＯＫにする
objEXCEL.Workbooks.Open FileName:="D:\VBA-TEST\Test048-Book.xls"
objEXCEL.Columns("D:D").Select
objEXCEL.Selection.Style = "Comma [0]"
End Sub
これで、軽く起動、操作が出来たら、あとは同様にマクロで記録して肉付けします。
A列を小数点２桁の999.99の形式にしたいのでマクロを記録
Sub Macro1()
Columns("A:A").Select
Selection.NumberFormatLocal = "0.00_ "
End Sub
これは、Ｅｘｃｅｌ側のマクロ記録で作ったVBAなので、
同じように、組み込む時は、頭にobjEXCELと参照用オブジェクトを付ける、
Private Sub btn起動_Click()
Dim objEXCEL As Object 'Excelを参照するためのオブジェクト
Set objEXCEL = CreateObject("Excel.Application") 'オブジェクト作成
objEXCEL.Visible = True '見えるようにする
objEXCEL.UserControl = True 'ユーザーの操作をＯＫにする
objEXCEL.Workbooks.Open FileName:="D:\VBA-TEST\Test048-Book.xls"
objEXCEL.Columns("D:D").Select
objEXCEL.Selection.Style = "Comma [0]"
objEXCEL.Columns("A:A").Select
objEXCEL.Selection.NumberFormatLocal = "0.00_ "
End Sub
とこんな感じで。
/*
* ５．余談、同じ位置のブックを開く
*/
マクロ記録で作成した、
objEXCEL.Workbooks.Open FileName:="D:\VBA-TEST\Test048-Book.xls"
と
"D:\VBA-TEST\Test048-Book.xls"
だとまずい時は、
In message "[VBAで楽しく No.007] - ＭＤＢと同フォルダのExcelファイルを開く",
http://www.ken3.org/backno/backno_vba02.html#7
を参考に（さりげなくバックナンバーを紹介（笑））
Private Sub btn起動_Click()
Dim objEXCEL As Object 'Excelを参照するためのオブジェクト
Dim strMDBPATH As String
Dim strWORK As String
Dim strXLSFILE As String
Dim i As Integer 'カウンター変数
'Accessの起動位置を取得 CurrentDb.NameにX:\xxxx\yyyy\zzz.mdbが入っている
strWORK = CurrentDb.Name
'後ろから１文字単位で￥を探す
For i = Len(strWORK) To 1 Step -1
If Mid(strWORK, i, 1) = "\" Then Exit For '￥だったら抜ける
Next i
'X:\xxxx\yyyy\zzz.mdb --> X:\xxxx\yyyy\ にする
strMDBPATH = Mid(strWORK, 1, i)
'Excelの元ファイルの名前を作成 X:\xxxx\yyyy\ ＋ Test048-Book.xls
strXLSFILE = strMDBPATH & "Test048-Book.xls"
'ファイルの存在をチェックする お約束
If Dir(strXLSFILE) = "" Then
MsgBox strXLSFILE & " を 確認して下さい"
Exit Sub '途中で抜ける
End If
Set objEXCEL = CreateObject("Excel.Application") 'オブジェクト作成
objEXCEL.Visible = True '見えるようにする
objEXCEL.UserControl = True 'ユーザーの操作をＯＫにする
objEXCEL.Workbooks.Open FileName:=strXLSFILE 'MDBと同じ位置
objEXCEL.Columns("D:D").Select
objEXCEL.Selection.Style = "Comma [0]"
objEXCEL.Columns("A:A").Select
objEXCEL.Selection.NumberFormatLocal = "0.00_ "
End Sub
いきなり、長くなったけど、こんな感じでパターン化すると楽です。
基本は、マクロ記録で探る、頭に参照用のオブジェクトを付けるです。
/*
* ６.おわりの挨拶
*/
今回は、
・Access --> Excel も、みんな好きですね
・Excelオブジェクトの作り方
・操作のプロパティ、メソッドをマクロ記録で探る
・実際の組み込みは簡単頭にオブジェクトを付けるだけ
でした。
あっ、質問って、
>「実行エラー'1004'
> RangeクラスのNumberFormatプロパティを設定できません」
>というエラーが出ます。
だった、
もしかして、Rangeの使い方の方かなぁ。
勝手に作者がもりあがって、自分の方法を解説したけど、
聞きたかったのは、違うことかも。
エラーのソースをコピーして、見せてくれると、
何かわかるかもしれません。
＊エラー内容と、ヶ所のソースがわからないと、なんとも言えないので。
何か素朴な疑問などあったら、メール、掲示板に気軽に書いてください。
サンプルファイルは、
http://www.ken3.org/vba/lzh/vba048.lzh
にtest048-book.xls, db048.mdbが保存されています。
(Excel97,Access97)
まっ、いろいろと不親切なサンプルだけど、
拾い読みして、
１つでも何かの参考となれば幸いです。
Ｅｘｃｅｌ／Ａｃｃｅｓｓ大好き、三流プログラマーＫｅｎ３でした。
＜Excel Rows(n).Select で行選択＞
こんにちは、三流プログラマーＫｅｎ３です。
今回は、
セルを選択して編集位置を見易くしてみた
~~~~~~~~~~~~~~を軽く書きたいと思います。
普通に使用しているとあまり関係無いので、
へぇ〜、そうなんだぁ程度に、気楽に読んでください。
サンプルファイルは、
http://www.ken3.org/vba/lzh/vba049.lzh
に
test049-book.xlsが保存されています。
遊んでみてください。
/*
* １．今回のキッカケ
*/
In message "Re: [VBAで楽しく No.042] - ExcelのForm シートと連動させる",
Y*******.T******* さん wrote...
>>Accessでフォーム作るのって意外と簡単ですよね。
>>入力フォーム作る時、
>>テーブルやクエリーのデータと連動させるので、
>>簡単にそれなりの入力フォームを作ることが出来ると思います。
>
>けんぞうはデータ−フォーム知らないの？
>Execl データ−フォーム で自動的に作れます
----
と、メールをいただく。
＊ご意見メール や 指摘メール好きなので、
日頃のストレス解消に（Ｋｅｎ３をガツンとやって）
じゃなくって、気軽に送ってくださいね。
えっと、
メニュー、データ、フォームを選択
おっ、表示された。
へぇ〜、こんなこと出来るんだぁ、少し感動。
←作成した画面
見出し行を判断して、自動的に作成してくれるみたいですね。
シートのイメージが
_____A_____________B_________C____________D_______________________E_______
1 画像タイトル ファイル名 コメント 画像ベースディレクトリ→ D:\temp\
2 サンタ 001.gif ケーキ写真
3 お正月 012.jpg XXXXXXXXXX
4
といった感じだったので、
D列を見出しと判断して少しおかしいけど、
入力フォーム簡単に作れるみたいですね。
おっと、感心している場合じゃなくて、屁理屈こねなきゃ。
えっと、フォームを自動で作れるの知らなかったけど、
画像表示をＥｘｃｅｌフォームでやりたかったから、作ったんだよボク。
＊ボクとか言って私（３０歳）より年上だったらどうしましょう、、（笑）
う〜ん、これだと説得力あまりないなぁ。。。
まぁもらったメールはクレームじゃなくって、
>Accessでフォーム作るのって意外と簡単ですよね
に対して、Excelでも簡単だよと教えてもらったメールだけどね。
この入力フォーム、いいんだけど、
ＶＢＡのコード作成してくれて、自分で肉付け出来るともっと便利だよね。
＊そんなツール、作ってみたいけど（フリーソフトであったりしてね）
/*
* ２．自作はいろいろ出来るんだぞ、、、、よし、編集位置をわかりやすくしよう
*/
自分でフォームを作成する、
メリットは、お手製の不具合もあるけど、
いろいろと自分好みにできることかなぁ（コードを書けば、、）
画像の表示も一例だけど、
今回は、
編集している行を反転して（マウスでクリックした反転状態）、
わかりやすくしてみます。
/*
* ３．Rows("4:4").Select
*/
前置き長かったけど、コード作成にとりかかります。
いつものマクロ記録で、行を選択してみる。
Sub Macro1()
Rows("4:4").Select
End Sub
Rows("4:4")
こいつが、行のオブジェクトで、
.Selectメソッドで選択かぁ、なんかあっけないよね。
さてと、組み込みますか。
現在位置のデータ行を選択させたいので、
位置が変わった時に実行しているモジュール、
Sub SheetToForm() 'セルの値をフォームのテキストボックスに代入する
txtTITLE = Sheets("DATA").Cells(yCNT, "A")
txtFILENAME = Sheets("DATA").Cells(yCNT, "B")
txtMEMO = Sheets("DATA").Cells(yCNT, "C")
Rows(yCNT & ":" & yCNT).Select '行を選択 vba049で追加
End Sub
に入れました。
さっそく実行、無事動きましたね。
←動作した画面
/*
* ４．マクロ記録の盲点
*/
でも、なんか、バカっぽいよね？
えっ、どこが？
Rows(yCNT & ":" & yCNT).Select '行を選択 vba049で追加
って、
Rows("4:4").Select
の"4:4"の文字列を直しただけだよね。
そうですね、別に動けばいいんじゃないの？
まぁ、そうなんだけど、＆で文字列を毎回作るのもなぁ。
そんな疑問があったり、数値直接で指定する方法があるはず
と読み、探してみました。
結果みると簡単で、
Rows(4).Select
と直接数値でＯＫなので（意外、別の指定方法あると思ってた）
Sub SheetToForm() 'セルの値をフォームのテキストボックスに代入する
txtTITLE = Sheets("DATA").Cells(yCNT, "A")
txtFILENAME = Sheets("DATA").Cells(yCNT, "B")
txtMEMO = Sheets("DATA").Cells(yCNT, "C")
Rows(yCNT).Select '行を選択 vba049で追加
End Sub
と
Rows(yCNT).Select '行を選択 vba049で追加
~~~~~~~~~~でＯＫです。
これなら、スッキリしてるかなぁ。
マクロ記録で作ると、オブジェクト調べるの楽だけど、
少し先のヘルプを見るのも必要かなぁとフト思った。
/*
* ５.おわりの挨拶
*/
今回は、
・Excel データ---フォーム で自動的にフォームを作成してくれます
・Rows("4:4").Select で 行選択
・Rows(4).Select と 書くことも出来ます
でした。
サンプルファイルは、
http://www.ken3.org/vba/lzh/vba049.lzh
に
test049-book.xlsが保存されています。
ユーザーフォーム、作ると楽しくて、ハマるでしょ？
何か素朴な疑問などあったら、メール、掲示板に気軽に書いてください。
拾い読みして、
１つでも何かの参考となれば幸いです。
Ｅｘｃｅｌ／Ａｃｃｅｓｓ大好き、三流プログラマーＫｅｎ３でした。
--------------------
読者からのお便り紹介
--------------------
掲示板の投稿からの抜き出しだけど、
http://www.ken3.org/cgi-bin/bbs/vba/wforum.cgi?mode=allread&no=44&page=0
>> う〜ん、エラーのコードを書いてもらえると、
>> 何かアドバイスできると思います。
>> あと、どのような書式に設定したいのですか？
>> 例）Ｅ列を日付型にしたくて、
>> XXXXXXと書いたらエラーになりました
>> なんて、やりたいこと と やったこと 、エラーの３つがわかると、
>> 回答し易いです。
>
>スイマセン。。。
>そうですよね〜
>何も具体的なこと書いてなかったですよね・・・
>後から自分の投稿文を読んではずかしくなりました。
>次回からは、気を付けます！
>
>ご丁寧なアドバイスありがとうございました。
>またまたお世話になるかもしれませんが
>よろしくお願いします(^O^)/~~~
----
お礼は、期待してないんだけど、あるとうれしいもんですね。
ホントは質問をメルマガのネタにしてるので、
こちらがお礼を言わないといけないんだけど（爆）
答えられる質問は、ネタとして流用したいので、
素朴な疑問、こんなことで困ってます、、
などあったら、掲示板、メールで送ってください。
ヨロシクです。
有料メルマガ http://www.ken3.org/pmagmag/ もヨロシクです。
検索して目的の情報を探す。
目的の情報を探すには、最近はググれとよく聞きます。なので、検索ボックスを付けました。
いろいろなキーワードを入れて、検索してみてください。
ページフッター
ここまで、読んでいただきどうもです。ここから下は、三流君宛のメッセージ送信や 三流君のホームページの紹介・案内です
目的の情報が見つかったか？少々心配しつつ、、、※質問や感想は、気軽に送ってくださいね。
質問や要望など メッセージを送る(三流君に連絡する)
質問や要望など連絡方法でお互い確認が取りやすく、便利なのが掲示板なのですが、私の対応のまずさから不定期で荒れてしまい、掲示板は現在封鎖中です。(反省しなきゃ)
|
|
感想や質問・要望・苦情など 三流君へメッセージを送る。
時間的余裕のある要望・質問・苦情の場合は、下記のフォームからメッセージを送ることができます。
|
急ぎで連絡がほしい、そんな時は:[三流君連絡先]に連絡してください。
リンクや広告など
項目別に↓に人気の記事をまとめてみました。お探しのジャンルを選択してください。
人気記事(来場者が多いTOP3):
[VBAでIE,WebBrowserを操作]・・・VBAでIE,WebBrowserを操作する サンプルです
[Access から Excel 連携 CreateObject("Excel.Application")]・・・AccessからExcelを操作したりデータの書き出しなどです
[VBAでOutlookの操作 CreateObject("Outlook.Application" )]・・・VBAからOutlookを使い、メール関係を処理するサンプルです
↑上記３つみたいなCreateObjectで他のアプリケーションを操作するサンプルが人気です。
開発時の操作:
[F1を押してHELPを見る]/
[Debug.Print と イミディエイトウインドウ]/
[実行時エラーでデバッグ]/
[ウォッチ式とSTOP]/
[参照設定を行う]
仕様書(設計書？) XXXX書類:
[基本設計書や要求仕様書]/
[テスト仕様書 テストデータ]/
[バグ票]/
[関数仕様書]/
[流れは 入力・処理・出力]
Excel関係:
[Excel UserFormを操作する]・・・エクセルでユーザーフォームを作成して入力などを行ってます
[ExcelからAccessを操作する]・・・ExcelからAccessのマクロを起動してみました、
[Excel関係 関数、その他]・・・その他Excel関係です
Access関係:
[Access UserForm/サブフォーム 操作]・・・アクセスでフォームを使ったサンプルです
[Access レポート操作]・・・レポートを操作してみました
[Access クエリーやその他関数]・・・あまりまとまってませんが、スポット的な単体関数の解説です
その他：VBAの共通関数やテキストファイルの操作など
[VBAでテキストファイル(TextFile)の操作]・・・普通のテキストファイルを使ったサンプルです
[VBA 標準関数関係とその他解説]・・・その他、グダグタ解説してます
Blog:[三流君の作業日記]/
[サンプルコードのゴミ箱]/
広告-[通販人気商品の足跡]
[三流君(TOP ken3.org へ戻る)]
/ [VBA系TOPへ]
/ [VBA系バックナンバー目次へ移動]
