Option Compare Database
‘*******************************************************
‘*
‘* フォーム間、値受け渡しの為、変数をpublicで定義
‘*
‘*******************************************************
Public strGenkahyou1 As String, strGenkahyou2 As String
Public taikaiDaimoku As String, taikaiSyuppinNen As String, taikaiSyuppinTuki As String, taikaiSakuseihi As String, taikaiPageNo As String
Public zeinukiGenka As String, zeikomiGenka As String
Public ShiireBi As String, TrihikisakiCode As String, TantoushaCode As String

Option Compare Database

Function BackUpFile(FolderPath, FileName)

‘***************フォルダ検索/ファイル検索/ファイルコピー********
‘
‘バックアップ作成場所のフォルダのパスと新規ファイル名を受け取り、
‘フォルダが存在しなければ、新規でフォルダを作成し、カレントファイルをコピー。
‘（yyyymmdd_backup.accdb）
‘***************************************************************
On Error GoTo err_FsoCopy:

Dim MyFSO As New FileSystemObject

‘カレントデータベースのファイル名を取得（コピー元のファイル名）
Dim sFileName As String
sFileName = MyFSO.GetFileName(Application.CurrentDb.Name)

‘フォルダ存在確認
‘Dim FolderPath As String
If Not MyFSO.FolderExists(FolderPath) Then
MsgBox “フォルダが存在しないため、作成します。”
MyFSO.CreateFolder Path:=FolderPath

End If

‘ファイル存在確認
‘Dim FileName As String
FileName = FolderPath & “\” & FileName
If MyFSO.FileExists(FileName) Then
If MsgBox(“同じファイル名が存在します。上書きしますか？”, vbCritical + vbOKCancel) = vbCancel Then
MsgBox “バックアップ処理を中止します。”
BackUpFile = False
Set MyFSO = Nothing
Exit Function
Else
MyFSO.DeleteFile FileSpec:=FileName
End If
End If
‘ファイルコピー
MyFSO.CopyFile Source:=CurrentProject.Path & “\” & sFileName, Destination:=FileName
MsgBox “バックアップ完了しました。”
BackUpFile = True
‘終了処理
err_Exit:
Set MyFSO = Nothing
Exit Function

‘エラー処理
err_FsoCopy:
MsgBox Err.Description
Err.Clear
Resume err_Exit:

End Function

Sub ExcelExport(FolderPath, FileName, TableName)
‘***************テーブルをエクセルでエクスポート******************
‘FolderPath：出力先のパス
‘FileName　：出力後のファイルネーム（.xlsx）
‘TableName　：コピー元のテーブル名
‘*******************************************************
‘On Error GoTo err_FsoExcel:

Dim MyFSO As New FileSystemObject

‘フォルダ存在確認
If Not MyFSO.FolderExists(FolderPath) Then
MsgBox “フォルダが存在しないため、作成します。”
MyFSO.CreateFolder Path:=FolderPath
End If

‘ファイル存在確認
FileName = FolderPath & “\” & FileName
If MyFSO.FileExists(FileName) Then
If MsgBox(“同じファイル名が存在します。上書きしますか？”, vbCritical + vbOKCancel) = vbCancel Then
MsgBox “エクスポートを中止します。”
Set MyFSO = Nothing
Exit Sub
Else
MyFSO.DeleteFile FileSpec:=FileName
End If
End If
‘エクスポート
DoCmd.OutputTo acOutputTable, TableName, acFormatXLSX, FileName, True
MsgBox “エクセルファイルで出力しました。”

‘終了処理
err_Exit:
Set MyFSO = Nothing
Exit Sub

‘エラー処理
err_FsoExcel:
MsgBox Err.Description
Err.Clear
Resume err_Exit:

End Sub
Sub ExcelExport2(FolderPath, FileName, TableName)
‘***************クエリをエクセルでエクスポート******************
‘FolderPath：出力先のパス
‘FileName　：出力後のファイルネーム（.xlsx）
‘TableName　：コピー元のテーブル名
‘*******************************************************
‘On Error GoTo err_FsoExcel:

Dim MyFSO As New FileSystemObject

‘フォルダ存在確認
If Not MyFSO.FolderExists(FolderPath) Then
MsgBox “フォルダが存在しないため、作成します。”
MyFSO.CreateFolder Path:=FolderPath
End If

‘ファイル存在確認
FileName = FolderPath & “\” & FileName
If MyFSO.FileExists(FileName) Then
If MsgBox(“同じファイル名が存在します。上書きしますか？”, vbCritical + vbOKCancel) = vbCancel Then
MsgBox “エクスポートを中止します。”
Set MyFSO = Nothing
Exit Sub
Else
MyFSO.DeleteFile FileSpec:=FileName
End If
End If
‘エクスポート
DoCmd.OutputTo acOutputQuery, TableName, acFormatXLSX, FileName, True
MsgBox “エクセルファイルで出力しました。”

‘終了処理
err_Exit:
Set MyFSO = Nothing
Exit Sub

‘エラー処理
err_FsoExcel:
MsgBox Err.Description
Err.Clear
Resume err_Exit:

End Sub

Option Compare Database
Sub リボン非表示()
‘リボン非表示
DoCmd.ShowToolbar “Ribbon”, acToolbarNo

‘ナビゲーションウィンドウを非表示にする
DoCmd.SelectObject acForm, “”, True
DoCmd.RunCommand acCmdWindowHide

End Sub

Sub リボン表示()
‘リボン表示
DoCmd.ShowToolbar “Ribbon”, acToolbarYes

‘ナビゲーションウィンドウを表示する
DoCmd.SelectObject acForm, “”, True
End Sub

Option Compare Database

Sub XLSExport(TableName, FilePath)
‘************************************************
‘エクセルファイルをエクスポートする
‘ 　TableName： エクスポート元のソースのテーブル
‘ FilePath　：エクスポート先のエクセルファイルのパス+ファイル名
‘
‘************************************************

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, TableName, FilePath
End Sub
Sub XLSInport(TableName, FilePath)
‘************************************************
‘エクセルファイルをインポートする
‘ 　TableName :インポート先のテーブル
‘ FilePath　:インポート元のエクセルファイルのパス+ファイル名(先頭のワークシートを読み込む）
‘ True　　　:1行目をフィールド名とする
‘************************************************
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, TableName, FilePath, True
End Sub

Option Compare Database
Sub FormSizeStandard()
DoCmd.MoveSize 1000, 500, 12000, 9000
End Sub

Sub FormSizeWide()
DoCmd.MoveSize 1000, 500, 20000, 9000
End Sub

Sub FormSizeSquare()
DoCmd.MoveSize 1000, 200, 12000, 12000
End Sub

Sub FormSizeWide2()
DoCmd.MoveSize 1000, 500, 14000, 10000
End Sub
Sub FormSizeSquare2()
DoCmd.MoveSize 1000, 200, 14000, 12000
End Sub
Sub FormSizeWide3()
DoCmd.MoveSize 1000, 200, 18000, 12000
End Sub
Sub FormSizeWide4()
DoCmd.MoveSize 1000, 200, 15000, 12000
End Sub
Sub FormSizeSmall1()
DoCmd.MoveSize 1000, 500, 5000, 9000
End Sub
Sub FormSizeSmall2()
DoCmd.MoveSize 1000, 500, 7000, 9000
End Sub
Sub FormSizeSmall3()
DoCmd.MoveSize 1000, 500, 7000, 11000
End Sub

Option Compare Database

Public Function FDFolderPicker()
‘*********************************************
‘*　　[参照] ダイアログ ボックス(フォルダ参照)
‘*********************************************
‘[参照] ダイアログ ボックスの FileDialog オブジェクトを作成します。
Dim fd As FileDialog

Set fd = Application.FileDialog(msoFileDialogFolderPicker)
‘選択した各アイテムのパスを保存す変数を宣言します。
Dim vrtSelectedItem As Variant

‘プロパティの設定
With fd
.Title = “フォルダ参照ダイアログ”

.InitialView = msoFileDialogViewDetails
.InitialFileName = “C:\”

‘[参照] ダイアログ ボックスを表示します。
If .Show = -1 Then
‘ユーザーがアクション ボタンをクリックした場合
For Each vrtSelectedItem In .SelectedItems
FDFolderPicker = vrtSelectedItem
Next vrtSelectedItem
Else
‘ユーザーが [キャンセル] をクリックした場合
End If
End With

‘オブジェクトの変数に Nothing を設定します。
Set fd = Nothing

End Function
Public Function FDFilePicker()
‘*********************************************
‘*　　[参照] ダイアログ ボックス(ファイル参照)
‘*********************************************
‘[参照] ダイアログ ボックスの FileDialog オブジェクトを作成します。
Dim fd As FileDialog

Set fd = Application.FileDialog(msoFileDialogFilePicker)
‘選択した各アイテムのパスを保存す変数を宣言します。
Dim vrtSelectedItem As Variant

‘プロパティの設定
With fd
.Title = “サンプルダイアログ（ファイル参照）”
‘フィルターの設定
.Filters.Clear
.Filters.Add “テキスト”, “*.txt; *.csv”
.Filters.Add “エクセル”, “*.xls”
.Filters.Add “Access”, “*.mdb”
.Filters.Add “イメージ”, “*.gif; *.jpg; *.jpeg”
.Filters.Add “すべてのファイル”, “*.*”
.FilterIndex = 3

.InitialView = msoFileDialogViewDetails
.InitialFileName = CurrentProject.Path
.AllowMultiSelect = False

‘[参照] ダイアログ ボックスを表示します。
If .Show = -1 Then
‘ユーザーがアクション ボタンをクリックした場合
For Each vrtSelectedItem In .SelectedItems
FDFilePicker = vrtSelectedItem
Next vrtSelectedItem
Else
‘ユーザーが [キャンセル] をクリックした場合
End If
End With

‘オブジェクトの変数に Nothing を設定します。
Set fd = Nothing

End Function

Option Compare Database

‘/＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
‘/＊
‘/＊　　　　　　　　　　　共通メッセージ
‘/＊
‘/＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Public Const comMsg0001 As String = “登録しました。”
Public Const comMsg0002 As String = “削除しました。”
Public Const comMsg0003 As String = “内容が変更されています。閉じる前に登録しますか？”
Public Const comMsg0004 As String = “マスタを削除するとあらゆる処理で障害が発生しますが、よろしいですか？”
Public Const comMsg0005 As String = “削除してよろしいですか？”
Public Const comMsg0006 As String = “出力該当データはありません。”
Public Const comMsg0007 As String = “これ以前のコードはありません。”
Public Const comMsg0008 As String = “これ以後のコードはありません。”
Public Const comMsg0009 As String = “内容が変更されています。印刷前に登録しますか？”
Public Const comMsg0010 As String = “内容が変更されています。新規データに移動する前に登録しますか？”
Public Const comMsg0011 As String = “内容が変更されています。前データに移動する前に登録しますか？”
Public Const comMsg0012 As String = “内容が変更されています。後データに移動する前に登録しますか”
Public Const comMsg0013 As String = “処理を中止しました。”
Public Const comMsg0014 As String = “エラー発生処理は完了しておりません。”
Public Const comMsg0015 As String = “障害発生データは登録できませんでした。”
Public Const comMsg0016 As String = “障害発生データは削除できませんでした。”
Public Const comMsg0017 As String = “エクスポートを完了しました。”

‘/＊共通メッセージ補助
Public Const cmdMsgtittle1 As String = “確認”
Public Const cmdMsgtittle2 As String = “エラー”

‘/＊パスワード
‘管理者用（adomin）
Public Const adominPW As String = “password”
‘ユーザー用（user）
Public Const userPW As String = “user”

‘背景画像のファイルのパスを指定
Public Const BgImageDataPath As String = “c:\背景08.jpg”

「ORDER BY」で複数条件指定が可能

例1）

SELECT id, 会社名, 郵便番号, 住所,電話番号,メールアドレス FROM tb住所録 ORDER BY 氏名, 郵便番号

⇒先に氏名でソートされ、次に郵便番号でソートされる

例2）

SELECT id, 会社名, 郵便番号, 住所,電話番号,メールアドレス FROM tb住所録 ORDER BY 氏名 desc, 郵便番号

⇒個別にDESCやASCの指定も可能