ACCESS備忘録

テーマ:

クエリーからレコードの追加が出来ない


サブフォームへのフォーカスの移動


親フォームへのフォーカスの移動


SUBフォーム 値の参照


コンボボックスに規定値を指定する


サブフォーム、自由自在にサイズ変更


OpenFormで指定するクラスの定数


Excelファイルフルパス取得の関数


クエリーのエクスポート関数


テーブルのエクスポート関数


Excelシートのインポート関数


ちょっぴり複雑なクエリーの抽出条件


主キーについて


AccessからExcelを編集する


 


 ドキドキ質問や記事の要望などありましたら、コメントしていただければ追加していきたいと思います(-^□^-)


AD


Dim XLS As Object
Dim WkB As Object

Dim i As Integer
Dim Excel_Adr, Excel_Name, Wk_Excel_Name As String

Excel_Adr = CurrentProject.Path 'Accessの保存されているフォルダ

Excel_Name = Excelファイル名

Wk_Excel_Name = Excelシート名


'クエリーをエクセルに出力(新規Excelファイルへ)

’詳細は[クエリーのエクスポート関数 ]参照
Call EXP_Que("クエリー名", Excel_Adr & "\" & Excel_Name, 2)

Set XLS = CreateObject("Excel.application")
Set WkB = XLS.Workbooks.Open(Excel_Adr & "\" & Excel_Name)

'Excelを表示する

XLS.Visible = True


'Excelのワークシート関数を使用

'A列に値が入っているセルの数を取得
i = XLS.Application.CountA(WkB.Worksheets(1).Range("A:A"))

'罫線を引く

WkB.Worksheets(1).Range("A1:C" & i).Borders.LineStyle = xlContinuous

'セル内折り返しを無しにする

WkB.Worksheets(1).Range("A1:C" & i).WrapText = False

'行の高さを自動調整する

WkB.Worksheets(1).Rows("1:" & i).EntireRow.AutoFit

'列幅を自動調整する

WkB.Worksheets(1).Range("A:C").EntireColumn.AutoFit

'条件付き書式を追加する

'上のセルと値が同じ場合
WkB.Worksheets(1).Range("A1:A" & i).FormatConditions.Add Type:=xlExpression, Formula1:="=R[-1]C=RC"
'文字の色を白にする

WkB.Worksheets(1).Range("A1:A" & i).FormatConditions(1).Font.ColorIndex = 2


’シート名の設定
WkB.Worksheets(1).Name =Excelシート名


'Excelを保存する

XLS.Workbooks(Excel_Name).Save

'Excelを閉じる(保存はNoで)

XLS.Workbooks(Excel_Name).Close SaveChanges:=False


Set WkB = Nothing
Set XLS = Nothing


☆メニュー☆


AD

主キーについて

テーマ:

どこかでテーブルの主キーについて質問しているのを見かけました。


意外に分かられてない方が多いようだったので、返事をしようと思ったら登録しないと返事も出来なかったので、返事をするのをやめました。


そんな方の為に、主キーについてちょっと書いてみようと思います。


データベースには、「キー」というものが必要となります。


その「キー」は、テーブルとテーブルを繋ぐためのもので、データの管理を容易にする為の物なのですが、繋ぐと言う事は、キーの重複は許されないと言うことになります。


たとえば、


  伝票テーブル   明細テーブル   顧客テーブル
■■ 伝票№ ■■ 伝票№ ■■ 顧客№
  顧客№   明細№   顧客名
  伝票日付   商品№   住所
  備考   数量   電話番号
      担当者名



というテーブルを作る場合、このままでは、「主キーが設定されていません」と言うメッセージと共に、主キーの設定を促され、[はい]を選ぶと、IDと言う名前のオートナンバー型の項目が追加されます。


ですが、このテーブルの場合、例えば「伝票テーブル」ですが、伝票№という一つのレコードを管理するための項目がすでに用意されています。


これを主キーにすれば良いので、[キャンセル]を選び、伝票№を主キーに設定しなおせば、前述のメッセージは表示されなくなります。(この場合、重複不可となります)


次に「明細テーブル」ですが、此処には3つの№があります。明細№だけをキーにしてしまうことも出来るのですがそうすると重複が許されず、伝票単位では1件目のデータも100等と言った数値になってしまいます。(1項目のみでの主キー設定は重複不可が原則となる為)


出来れば明細№を1から振って帳票に出力したいところですね。


そういう場合は、伝票№と明細№の二つを選択してから主キー設定を行います。そうすると、それぞれの項目は重複を許されますが、二つセットで見た場合重複不可となります。


ちなみに、商品№は他に商品テーブル(商品名や価格情報を保有させる)を用意して、商品テーブルで主キー設定を行いフォームやレポートで活用します。(入力を容易にするためのものです)


そして、最後に顧客テーブルですが、これは顧客№を主キーに設定し、伝票テーブルで呼び出しを行います。

その為顧客№の重複は不可となります。


営業所が複数ある。とか、複数の担当者を管理したいと言う場合もあると思いますが、顧客テーブルで複数キーで管理するのは得策ではありません。


顧客名のみ同じである場合は、別№で顧客登録を行い、担当者が複数名いて、担当者1、担当者2としていくのはちょっと……と言う場合は、担当者テーブル(顧客№、担当者№、担当者名のような感じで)を作成し、担当者名を削除します。


そして、顧客№、担当者№の二つで主キーを作成し、顧客テーブルとは顧客№でリンクさせます。



  伝票テーブル   明細テーブル   顧客テーブル
主キー 伝票№ 主キー 明細№ 主キー 顧客№
  顧客№ 伝票№   顧客名
  伝票日付   商品№   住所
  備考   数量   電話番号
      担当者名

こうしていけば、主キーはオートナンバーの必要はありませんが、伝票№などは自動的に連番がついてくれると管理が楽なのでオートナンバーを活用し、明細№は自分で数値を入れる必要が出てきます。


また、顧客テーブルなどは顧客№を使わずとも、顧客名を主キーにすることも可能ですが、データ入力等を考慮すると数値の方が扱いやすいかと思います。


ちなみに、伝票テーブルの場合、キー(他のテーブルとリンクさせるもの)は[伝票№]と[顧客№]になりますが、伝票テーブルのそれぞれのレコードを単一のものとして管理するためのキーは、[伝票№]となり、主キーが[伝票№]となるわけです。


説明が下手なので、分かりにくかったかもしれませんあせる

コメントを書いていただければ、追加で説明を記入したりもすると思いますあせる


☆メニュー☆


AD

クエリーの抽出条件で、フォームなどで対象者を指定して出力という場合、通常、クエリーの抽出条件に、


[Forms]![フォーム名]![コントロール名]


を入力するが、


対象者を指定した場合は対象者、指定しなかった場合は全員とする場合は、


クエリーのフィールドに、

※例は対象者をキー(数値)で管理しています。


算式1:IIf(IsNumeric([Forms]![フォーム名]![コントロール名])=True,[フィールド名]=[Forms]![フォーム名]![コントロール名],[フィールド名]>0)


と入力すると、


[Forms]![フォーム名]![コントロール名]が数値の場合は、[フィールド名]が[Forms]![フォーム名]![コントロール名]と同じ場合Trueが表示され、それ以外はFalseとなり、[Forms]![フォーム名]![コントロール名]が数値でない場合、0より大きい数値全てがTrueとなる。


なので、[算式1]の抽出条件にTrueを指定すると、対象者を指定した場合は対象者を、指定しなかった場合は全員を抽出します。


☆メニュー☆

Function INP_TBL(TBL_Name, Excel_Adress, Excel_SheetName, Para)
'TBL_Name     ・・・ インポートするテーブル名
'Excel_Adress   ・・・ Excelファイルのフルパス
'Excel_SheetName ・・・ Excelシート名
'Para       ・・・ 処理の選択
On Error GoTo ERR_INP_TBL

Dim strMsg As String

If Dir(Excel_Adress) = "" Then
MsgBox "エクセルファイルが存在しません"
Else

Select Case Para
Case 1 '既存テーブルを削除してテーブルを作成します。
'1行目をフィールド名として使用しません
DoCmd.DeleteObject acTable, TBL_Name
If InStr(Excel_SheetName, "!") > 0 Then
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, TBL_Name, Excel_Adress, False, Excel_SheetName
Else
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, TBL_Name, Excel_Adress, False, Excel_SheetName & "!"
End If
Case 2 '既存テーブルを削除してテーブルを作成します。
'1行目をフィールド名として使用します
DoCmd.DeleteObject acTable, TBL_Name
If InStr(Excel_SheetName, "!") > 0 Then
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, TBL_Name, Excel_Adress, True, Excel_SheetName
Else
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, TBL_Name, Excel_Adress, True, Excel_SheetName & "!"
End If
Case 3 '既存テーブルにレコードを追加します
'1行目をフィールド名として使用しません
If InStr(Excel_SheetName, "!") > 0 Then
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, TBL_Name, Excel_Adress, False, Excel_SheetName
Else
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, TBL_Name, Excel_Adress, False, Excel_SheetName & "!"
End If
Case 4 '既存テーブルにレコードを追加します
'1行目をフィールド名として使用します
If InStr(Excel_SheetName, "!") > 0 Then
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, TBL_Name, Excel_Adress, True, Excel_SheetName
Else
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, TBL_Name, Excel_Adress, True, Excel_SheetName & "!"
End If
Case 5 '既存テーブルのレコードを削除して追加します
'1行目をフィールド名として使用しません
DoCmd.RunSQL "DELETE " & TBL_Name & ".* FROM " & TBL_Name & ";"

If InStr(Excel_SheetName, "!") > 0 Then
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, TBL_Name, Excel_Adress, False, Excel_SheetName
Else
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, TBL_Name, Excel_Adress, False, Excel_SheetName & "!"
End If
Case 6 '既存テーブルのレコードを削除して追加します
'1行目をフィールド名として使用します
DoCmd.RunSQL "DELETE " & TBL_Name & ".* FROM " & TBL_Name & ";"
If InStr(Excel_SheetName, "!") > 0 Then
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, TBL_Name, Excel_Adress, True, Excel_SheetName
Else
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, TBL_Name, Excel_Adress, True, Excel_SheetName & "!"
End If

End Select
End If
Exit Function

ERR_INP_TBL:

If Err.Number = 3044 Then
MsgBox "Excelファイルのパス指定が誤っています。", vbCritical, "INP_TBL"
ElseIf Err.Number = 7874 Then '指定テーブルがない場合、テーブル削除のコードを飛ばして処理を行います
Resume Next
Else
MsgBox Error, vbCritical
End If

End Function


☆メニュー☆

Function XLSFileOpen()

On Error GoTo エラー

Dim objXLS As New Excel.Application
Dim varGetFile As Variant

varGetFile = objXLS.GetOpenFilename("Excelファイル (*.xls), *.xls") 'エクセル以外のファイルを選択したいときはここを修正してください
If varGetFile = False Then
End
End If

XLSFileOpen = varGetFile
Set objXLS = Nothing

Exit Function

エラー:

MsgBox Error & vbNewLine & Err.Number & vbNewLine & Err.Description, , "XLSFileOpen"
End

End Function


****************************************************************

こんな感じで使えます


Private Sub BTM_インポートファイル指定_Click()
Me.インポートファイル = XLSFileOpen

End Sub



☆メニュー☆



Function EXP_Que(varAccess, varExcelPass, Para)
'varAccess  ・・・ テーブル名
'varExcelPass ・・・ エクセルファイルのフルパス
'Para     ・・・ 処理の選択
On Error GoTo ERR_EXP_Que
Dim strMsg As String

Select Case Para
Case 1 'シートの追加
DoCmd.TransferSpreadsheet acExport, 8, varAccess, varExcelPass, False, ""
Case 2 '既存シート削除後追加
DoCmd.OutputTo acOutputQuery, varAccess, acFormatXLS, varExcelPass, False
Case 3 '既存シート削除後HTMLで追加
DoCmd.OutputTo acOutputQuery, varAccess, acFormatHTML, varExcelPass, False
End Select
Exit Function

ERR_EXP_Que:

If Err.Number = 3044 Then
MsgBox "ファイルのパス指定が誤っています。", vbCritical, "EXP_Que"
Else
MsgBox Err.Number & ":" & Error, vbCritical
End If

End Function


☆メニュー☆


Function EXP_TBL(varAccess, varExcelPass, Para)
'varAccess  ・・・ テーブル名
'varExcelPass ・・・ エクセルファイルのフルパス
'Para     ・・・ 処理の選択
On Error GoTo ERR_EXP_TBL

Dim strMsg As String

Select Case Para
Case 1 'シートの追加
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, varAccess, varExcelPass, True, ""
Case 2 '既存シート削除後追加
DoCmd.OutputTo acOutputTable, varAccess, acFormatXLS, varExcelPass, False
Case 3 '既存シート削除後HTMLで追加
DoCmd.OutputTo acOutputTable, varAccess, acFormatHTML, varExcelPass, False
End Select
Exit Function

ERR_EXP_TBL:

If Err.Number = 3044 Then
MsgBox "Excelファイルのパス指定が誤っています。", vbCritical, "EXP_TBL"
Else
MsgBox Error, vbCritical
End If

End Function

☆メニュー☆


 

DoCmd.OpenForm(FormName, View, FilterName, WhereCondition, DataMode, WindowMode, OpenArgs)

FormName」と言う名前のフォームを開きます。

設定項目 内容
FormName フォームの名前を文字列式で指定[省略不可]
View ビュー形式をAcFormViewクラス※1の定数で指定[省略可能]
FilterName データを抽出するためのクエリ名を指定[省略可能]
WhereCondition データを抽出するためのSQL文のWHERE句を文字列式で指定
(「WHERE」は不要)[省略可能]
DataMode 入力モードをAcFormOpenDataModeクラス※2の定数で指定
WindowMode ウィンドウ形式をAcWindowMode※3クラスの定数で指定[省略可能]
OpenArgs 開くフォームのOpenArgsプロパティに設定する値を文字列式で指定[省略可能]

※1 引数に指定する定数(acFormViewクラス)

定数 説明
acDesign デザインビュー
acFormDS データシートビュー
acFormPivotChart ピボットグラフビュー
acFormPivotTable ピボットテーブルビュー
acNormal フォームビュー(既定値)
acPreview 印刷プレビュー

※2 引数に指定する定数(acFormOpenDataModeクラス)

定数 説明
acFormAdd  追加
acFormEdit 編集
acFormPropertySettings フォームのプロパティで設定されたモード(既定値)
acFormReadOnly  参照専用

 

※3 引数に指定する定数(acWindowModeクラス)

定数 説明
acDialog   ダイアログ形式
acHidden 非表示
acIcon  最小化
acWindowNormal  通常のウィンドウ(既定値)

☆メニュー☆

フォームサンプル


詳細部が表形式のサブフォームになっているデザインのフォームがあって、親フォームがサイズ変更が可能になっている場合、そのままだと、最初に設定したとおりのサイズでしかサブフォームは表示されない。

 

が、表形式のデータ入力画面の場合は、親フォームを最大化したら、サブフォームもそれにあわせて大きくしたいし、ほかの画面を見ながらやりたいときは、親フォームに合わせて小さくもしたい。

 

そういう場合、自動的に親フォームに合わせて、サブフォームのサイズを変更することが必要になります。

 

のでので、[(親)フォーム]の[プロパティー]から、[イベント]-[サイズ変更時]で、[イベントプロシージャ]を指定して、下記のようなコードを入れるとサイズ変更が出来るようになります

 

Private Sub Form_Resize()

 

Dim intWindowHeight As Integer       'フォームビューの高さ
Dim intWindowWidth As Integer        'フォームビューの幅
Dim intTotalFormHeight As Integer      'デザインビュー全体の高さ
Dim
intTotalFormWidth As Integer      'デザインビュー全体の幅
Dim intHeightHeader As Integer       'デザインビュー ヘッダーの高さ
Dim
intHeightFooter As Integer       'デザインビュー フッターの高さ


' フォームのデザインビューの高さを取得します。

' 詳細部は、後で指定するので、ヘッダー部・フッター部の合計値を出します


' ヘッダー部

intHeightHeader = Me.Section(acHeader).Height


' フッター部

intHeightFooter = Me.Section(acFooter).Height


intTotalFormHeight = intHeightHeader + intHeightFooter


' フォームのデザインビューの幅を取得します。
intTotalFormWidth = Me.Width


' フォームビューの高さを取得します。
intWindowHeight = Me.InsideHeight

' フォームビューの幅を取得します。

intWindowWidth = Me.InsideWidth

 

' 詳細部(サブフォーム部)の高さを指定します
' 詳細部の最小値を決めておいて、その値よりも小さくなる場合は数値を指定しています。

If intWindowHeight - intTotalFormHeight < 2568 Then

' サブフォームのコントロールの高さを指定します

Me.SUB_明細入力F.Height = 2568      

' 詳細部の高さを指定します

Me.Section(acDetail).Height = 2568  
Else
Me.SUB_明細入力F.Height = intWindowHeight - intTotalFormHeight
Me.Section(acDetail).Height = intWindowHeight - intTotalFormHeight

End If

' サブフォームのコントロールの幅を指定します
Me.SUB_明細入力F.Width = Me.InsideWidth

' デザインビュー全体の高さを算出します
intTotalFormHeight = intTotalFormHeight + Me.Section(acDetail).Height


' フォームビューの最小値を決めておき、その値よりも小さい場合は指定したサイズになるように変更します
' フォームビューの高さを変更する
If intWindowHeight < intTotalFormHeight Then
Me.InsideHeight = 5115        '
フォームビューの高さ
End If

' フォームビューの幅の変更と、スクロールバーの指定
If intWindowWidth < 16455 Then
If intWindowWidth < 6360 Then
Me.InsideWidth = 6360       '
フォームビューの幅
End If

' 横スクロールバーを表示します
Me.ScrollBars = 1
Else

' スクロールバーを消します
Me.ScrollBars = 0
End If

End Sub

このままで、問題ありませんでした。



ただし、サブフォームが「開くとき」に「別フォームを開く」コードを書いている場合、一旦フォーカスがその別のフォームに移動してしまい、動きがおかしくなってしまいました。


(最大化した状態で、サブフォームが見えなくなるまでAccessウィンドウを小さくすると、その後サブフォームを見える状態にしたときに、「開く時」のコマンドが実行されているようです。)


ので、私は、別フォームは見える必要がなかったので、非表示(acHidden)をセットすることにしました。(OpenFormで指定するクラスの定数 参照)

そうすると、上記コードで問題なく動きます

☆メニュー☆