36
' VBA検索プログラム Public Sub SampleProgramDAO1()
Dim SheetName As String Dim strName As String SheetName = "Sheet2"
'コンボボックスの値から商品名を取得します。
With ThisWorkbook.Worksheets(SheetName).DropDowns(1) strName = .List(.Value)
End With
If SampleProgramDAOFunc(SheetName, 7, 2, _
"SELECT * FROM 商品テーブルWHERE 商品名='" & strName & "'", 0) = True Then '最後にメッセージボックスを表示します。
MsgBox strName & "のデータを抽出しました。", vbExclamation, "メッセージ"
End If End Sub ' VBA全抽出プログラム Public Sub SampleProgramDAO2()
SampleProgramDAOFunc "Sheet2", 7, 2, "SELECT * FROM 商品テーブル", 0 End Sub
' DAO取得処理
Function SampleProgramDAOFunc(SheetName As String, Y As Long, X As Integer, _ SQL As String, Limit As Long) As Boolean
Dim strName As String '商品名
Dim rngCell As Range, lngRow As Long, lngCol As Long Dim wrkODBC As DAO.Workspace
Dim dbsPubs As DAO.Database Dim rstPubs As DAO.Recordset Dim DataCount As Long ' On Error GoTo Sub_Err
' ゲージダイアログを０にして消去 ResetGuage
UserForm1.Show DoEvents
Application.ScreenUpdating = False
データベースからデータを抽出します。
'ODBCDirect Workspace オブジェクトを作成します。
Set wrkODBC = DAO.CreateWorkspace("ｻﾝﾌﾟﾙﾃﾞｰﾀ", "admin", "", dbUseODBC) 'Database オブジェクトを開きます。
Set dbsPubs = wrkODBC.OpenDatabase("ｻﾝﾌﾟﾙﾃﾞｰﾀ", dbDriverComplete, True) 'Recordset にデータを取得します。
Set rstPubs = dbsPubs.OpenRecordset(SQL, dbOpenSnapshot, dbRunAsync) ' Set rstPubs = dbsPubs.OpenRecordset(SQL, dbOpenDynaset, dbRunAsync)
'Set NewQRY = db.CreateQueryDef("", QString) '件数を取得
rstPubs.MoveLast DataCount = rstPubs.RecordCount
rstPubs.MoveFirst
'件数が多いときはRecordCountがうまくかえってこないため再カウントしてみる
If DataCount = -1 Then DataCount = 0 Do While Not rstPubs.EOF
DataCount = DataCount + 1 rstPubs.MoveNext
Loop rstPubs.MoveFirst
End If
' Limitをこえる場合はLimit件数のみを取得(Limit =0 のときは全部) If Limit > 0 And DataCount > Limit Then DataCount = Limi
' If DataCount > 0 Then 'セルに書き込みます。
With ThisWorkbook.Worksheets(SheetName) ' 既存データ消去
.Range(.Cells(Y, X), .Cells(65535, X + rstPubs.Fields.Count - 1)).Value = ""
With .Cells(Y, X)
For lngCol = 0 To rstPubs.Fields.Count - 1 .Offset(0, lngCol).Value = rstPubs.Fields(lngCol).Name Next
lngRow = 1
Do While (Not rstPubs.EOF) And (lngRow <= DataCount) For lngCol = 0 To rstPubs.Fields.Count - 1
.Offset(lngRow, lngCol).Value = rstPubs.Fields(lngCol).Value Next
SetGuage lngRow / DataCount * 15 lngRow = lngRow + 1 rstPubs.MoveNext Loop End With End With End If
'各オブジェクトを開放します。
rstPubs.Close dbsPubs.Close wrkODBC.Close Set rstPubs = Nothing Set dbsPubs = Nothing Set wrkODBC = Nothing ' ゲージダイアログを０にして消去 ResetGuage
UserForm1.Hide
Application.ScreenUpdating = True SampleProgramDAOFunc = True
Exit Function Sub_Err:
' ゲージダイアログを０にして消去 ResetGuage
UserForm1.Hide
Application.ScreenUpdating = True MsgBox "データ取得中にエラーが発生しました。"
End Function ' ゲージ設定処理
Private Sub SetGuage(n As Integer) Dim i As Integer
For i = 1 To n
UserForm1.Controls("D" & Trim(i)).BackColor = &H800000 DoEvents
Next i End Sub 'ゲージリセット処理 Public Sub ResetGuage()
Dim i As Integer For i = 1 To 15
UserForm1.Controls("D" & Trim(i)).BackColor = &HE0E0E0 お
VBAの場合
137
ステップ となります。「超Excel」とは・・ Excelのシステム開発基盤に
37
「超」Excelは下記のExcel課題を解消します!
明細データをブック 内に残さないで開発
更にStiLLには 独自の保護機能有 ダウンロード
スピード20倍以上 再計算解消 脱VBA上位互換
排他 プログラム可 モジュール
なし
プログラム 記述行数 1/20
シート・オブジェクト 利用制御
Excelリボン 非表示 セル右クリック
制御や保護
Excelではできない 機能を強化・追加
WebDav サーバー
構築
ブック間リンク 解消 誰が作成
してもおなじ ようになるプロ
グラム作成 最近
なくなった
カレンダー ダイアログ等 Excelクエリー
データベース 機能等
いままで見た事が ない！と よく言われます 設定方式
プログラム作成
+ 「StiLL」
脱VBA上位互換
◆VBA Module技術不要 ◆「StiLL」コマンド上位互換!
リテラシーを考慮した画期的なプログラム開発手法
下記セルリンクボタン.xls(.xlsx) にはModuleがありません。 これが「StiLL」の プログラム
モジュールに 匹敵します。
ソースプログラム かつプログラム 仕様書です。
Windows3.1 Excel5.0 から現在まで
「StiLL」のコマンドは上位互換 38
作りやすく
直しやすく 仕様書同時生成
適合度合・納得度合高く
ずっと使える
◆ダウンロード
スピード20倍以上
◆再計算解消
※計算式最小限に
5000
行ダウンロード50
万行ダウンロード39
明細データをブック 内に残さないで開発
更にStiLLには 独自の保護機能有
明細データが存在しないように 簡単プログラム設定
40
活用ターゲット
基幹
ERP
連携・連動
業務支援系システム 入出力プログラム等情報系システム
定型・汎用部門業務システム
・小規模DB
・ITツール連動
部門業務システム
Excel業務
BI 経営ダッシュボード 共有シミュレーション
課題・解決分析システム BIシステム
Excelcsv集計
Excel報告書 整理・まとめ
Excelデータコピー・貼り付け
シミュレーション拡張管理システム
パッケージ連動 外部DB・小規模DB
見積書、伝票等 Excel適応帳票DWH
集計 報告書 ダッシュボード シミュレーション