Access+覚書
http://w.atwiki.jp/ac1226/
Access+覚書ja2012-03-22T17:25:04+09:001332404704新規入力
https://w.atwiki.jp/ac1226/pages/41.html
***1レコードのみ
Option Compare Database
Option Explicit
Dim flg As Boolean
Private Sub cmdA_Click()
If IsNull(Me.txtA) Or IsNull(Me.txtB) Then
MsgBox "未入力があります。"
If MsgBox("入力データは保存されません。 終了しますか?", vbYesNo + vbQuestion) = vbYes Then
flg = False
DoCmd.Close acForm, "f_new"
Else
Me.txtA.SetFocus
End If
Else
If MsgBox("入力データを保存して、終了しますか?", vbYesNo + vbQuestion) = vbYes Then
DoCmd.Close acForm, "f_new"
Else
MsgBox "保存しないで終了します。"
flg = False
DoCmd.Close acForm, "f_new"
End If
End If
End Sub
Private Sub Form_BeforeUpdate(Cancel As Integer)
If flg = False Then
Cancel = True
End If
End Sub
***複数レコード
Private Sub Form_BeforeInsert(Cancel As Integer)
cnt = DCount("*", "t_仮")
If cnt > 0 Then
Me.txtID = DMax("ID", "t_仮") + 1
Else
Me.txtID = DMax("ID", "t_A") + 1
End If
End Sub
Private Sub cmdEnd_Click()
Dim strSQL As String
DoCmd.SetWarnings False
If IsNull(Me.txtA) Or IsNull(Me.txtB) Then
MsgBox "未入力があります。"
If MsgBox("入力データは保存されません。 終了しますか?", vbYesNo + vbQuestion) = vbYes Then
DoCmd.Close acForm, "f_A"
strSQL = "DELETE * FROM t_仮"
DoCmd.RunSQL strSQL
Else
Me.txtA.SetFocus
End If
Else
If MsgBox("入力データを保存して、終了しますか?", vbYesNo + vbQuestion) = vbYes Then
DoCmd.Close acForm, "f_A"
strSQL = "INSERT INTO t_A ( ID, AA, BB ) " _
& "SELECT t_仮.ID, t_仮.AA, t_仮.BB FROM t_仮"
DoCmd.RunSQL strSQL
strSQL = "INSERT INTO t_B ( ID ) " _
& "SELECT t_仮.ID FROM t_仮"
DoCmd.RunSQL strSQL
strSQL = "INSERT INTO t_C ( ID ) " _
& "SELECT t_仮.ID FROM t_仮"
DoCmd.RunSQL strSQL
strSQL = "DELETE * FROM t_仮"
DoCmd.RunSQL strSQL
Else
MsgBox "保存しないで終了します。"
DoCmd.Close acForm, "f_A"
strSQL = "DELETE * FROM t_仮"
DoCmd.RunSQL strSQL
End If
End If
DoCmd.SetWarnings True
End Sub 2012-03-22T17:25:04+09:001332404704テキストボックス
https://w.atwiki.jp/ac1226/pages/22.html
***コントロールソース外の項目を表示
Me.txtAAA = DLookup("[項目]", "クエリ名")
***コントロールソース=DLookUp
=DLookUp("生年月日","t_A",ID = ID)
=DLookUp("生年月日","t_A","ID = " & ID)
=DLookUp("[Aname]","t_A","[A_ID]=[A_id]")
Me.txtA = DLookup("A名前", "t_A", "A_No=" & Me.txtB)
Me.txtB = DLookup("A名前", "t_A", "A_No='" & Me.txtB & "'")
***コントロールソースに設定
=IIf(IsNull([隠しテキスト]),"",
DLookUp("表示項目","t_テーブル","ID =" & [Forms]![f_フォーム]![隠しテキスト]))
***条件による切替
「txtA」 と 「txtB」 を同じ位置に置く
「txtB」 条件付き書式:[データ]=5
「txtB」 コントロールソース:=IIf([データ]=5,[txtB],[txtA])
Private Sub txtB_Enter()
If Me.txtB = "" Then
Me.txtA.SetFocus
Else
Screen.PreviousControl.SetFocus
End If
End Sub
***Nullチェック
Dim myFrm As Form, AryFld As Variant
Dim i As Long, j As Long
Set myFrm = Forms![f_main]![s_main]
AryFld = Array("txtA","txtB","txtC")
For i= 0 to 2
If IsNull(myFrm(AryFld(i))) Then
j = j + 1
End If
Next i
***前レコードの値をコピー
1. レコード移動時
Private Sub txt年月_AfterUpdate()
txt年月.DefaultValue = "'" & txt年月.Value & "'"
End Sub
2. テキストボックスをクリック時
Private Sub txt年月_Click()
Dim cnt As Integer
cnt = DCount("*", "t_A")
If cnt > 0 Then
Me.txt年月 = DLookup("[年月日]", "t_A", "[ID]-1")
End If
End Sub 2012-03-22T16:44:20+09:001332402260メニュー
https://w.atwiki.jp/ac1226/pages/2.html
**メニュー
-[[トップページ]]
-[[プラグイン紹介>プラグイン]]
-[[まとめサイト作成支援ツール]]
-[[Access]]
--[[2007]]
--[[レコード]]
--[[テーブル]]
--[[クエリ]]
--[[フォーム]]
---[[サブ]]
---[[機能]]
--[[レポート]]
--[[ツール]]
---[[テキストボックス]]
---[[コマンドボタン]]
----[[新規入力]]
---[[チェックボックス]]
---[[オプショングループ]]
---[[タブ]]
--[[inp]]
--[[exp]]
--[[Err]]
--[[モジュール]]
---[[SQL]]
---[[ユーザー関数]]
-[[Excel]]
-[[etc]]
-[[x]]
--[[1]]
-[[便利]]
--[[ショートカット]]
---[[Ac]]
---[[Ex]]
---[[Wd]]
**リンク
-[[@wiki>>http://atwiki.jp]]
-[[@wikiご利用ガイド>>http://atwiki.jp/guide/]]
**他のサービス
-[[無料ホームページ作成>>http://atpages.jp]]
-[[無料ブログ作成>>http://atword.jp]]
-[[2ch型掲示板レンタル>>http://atchs.jp]]
-[[無料掲示板レンタル>>http://atbbs.jp]]
-[[お絵かきレンタル>>http://atpaint.jp/]]
-[[無料ソーシャルプロフ>>http://sns.atfb.jp/]]
// リンクを張るには "[" 2つで文字列を括ります。
// ">" の左側に文字、右側にURLを記述するとリンクになります
//**更新履歴
//#recent(20)
&link_editmenu(text=ここを編集)
2012-03-22T13:49:29+09:001332391769機能
https://w.atwiki.jp/ac1226/pages/40.html
***Web検索みたいに空白でアンド検索
Private Sub cmd検索_Click()
On Error Resume Next
Dim strFilter As String
Dim strR_name As Variant
strR_name = Me.txt検索
If Not IsNull(strR_name) Then
' strFilter = "(R_name Like ""*" & strR_name & "*"")"
strFilter = "*" & Replace(strR_name, " ", "* And *") & "*"
strFilter = BuildCriteria("R_name", dbText, strFilter)
End If
If Not IsNull(strFilter) Then
'フィルタ設定
Me.Form.Filter = strFilter
Me.Form.FilterOn = True
Else
'フィルタ解除
Me.Form.FilterOn = False
End If
'RecordsetCloneにより件数表示(MoveLastは全件を正しく求めるため)
If Not Me.Form.RecordsetClone.EOF Then
Me.Form.RecordsetClone.MoveLast
End If
Me.該当件数 = Me.Form.RecordsetClone.RecordCount
If Nz(DCount("*", "t_1", strFilter), 0) = 0 Then
MsgBox "該当はありません"
End If
End Sub
***ハイパーリンクで該当ファイルを開く
Private Sub cmdOpen_Click()
'Me.openFile:ハイパーリンク型:パスを入力してある
Me.cmdOpen.HyperlinkAddress = Me.openFile
End Sub
2012-02-01T14:04:51+09:001328072691Ac
https://w.atwiki.jp/ac1226/pages/38.html
***改行
& vbCrLf &
***複数項目のNullチェック
'一つでもNullがあったら警告
If IsNull(Me.txt1 + Me.txt2 + Me.txt3) Then
MsgBox "txt1, txt2, txt3 はすべて入力必須です"
End If
'すぺてNullだったら警告
If IsNull(Me.txt1 & Me.txt2 & Me.txt3) Then
MsgBox "txt1, txt2, txt3 の中で一つ以上は入力してください"
End If
2011-11-02T14:44:33+09:001320212673Excel
https://w.atwiki.jp/ac1226/pages/17.html
*数値と文字の混在
「データ」→「区切り位置」を選択する
「列のデータ形式」で「文字列」を選択して「完了」
*最終行を探し、飛び飛びの列を選択
Sub test()
Dim r As Range
Dim MaxRow As Long
Dim ar As Variant
Dim buf As Variant
Dim i As Integer
Set r = ActiveSheet.UsedRange
ar = Evaluate("(" & r.Address & "<>"""")*(ROW(" & r.Address & "))")
For i = r.Rows.Count To 1 Step -1
buf = WorksheetFunction.Index(ar, i, 0)
MaxRow = WorksheetFunction.Max(buf)
If MaxRow > 0 Then
Exit For
End If
Next
MsgBox MaxRow
With ActiveSheet
Union(.Range("A1:D" & i), .Range("G1:G" & i)).Select
End With
End Sub
*Excel設定
Dim xlApp As New Excel.Application
Dim xlWb As New Excel.Workbook
MyPath = CurrentProject.Path & "\Test.xlsx"
Set xlApp = CreateObject("excel.application")
Set xlWb = xlApp.Workbooks.Open(FileName:=MyPath)
xlApp.DisplayAlerts = False
'xlWb.ActiveSheet.Cells.WrapText = False '折り返し無効
'xlWb.ActiveSheet.Cells.EntireColumn.AutoFit '例全体のセル幅調整
xlWb.Worksheets("AAA").Columns(1).Delete '2列目削除
xlWb.Worksheets("AAA").Cells.WrapText = False '折り返し無効
xlWb.Worksheets("AAA").Cells.EntireColumn.AutoFit '例全体のセル幅調整
xlWb.Worksheets("AAA").Cells.HorizontalAlignment = xlCenter '文字の配置
'xlWb.Worksheets("AAA").Rows(1).Interior.ColorIndex = 11 '背景色
xlWb.Worksheets("出力").Rows(1).Interior.Color = RGB(23, 55, 93)
xlWb.Worksheets("AAA").Rows(1).Font.ColorIndex = 2 '文字色
'A列同一値の結合
With xlWb.ActiveSheet
i = 2 '2行目から
j = i + 1
Do While .Cells(j, 1).Value <> ""
If .Cells(i, 1).Value = .Cells(j, 1).Value Then
.Range(.Cells(i, 1), .Cells(j, 1)).MergeCells = True
j = j + 1
Else
i = j
j = j + 1
End If
Loop
End With
xlWb.ActiveSheet.SaveAs MyPath, , , , , False 'バックアップ.xlkを作成しない
xlWb.Close SaveChanges:=True
xlApp.Quit
xlApp.DisplayAlerts = True
Set xlWb = Nothing
Set xlApp = Nothing
2011-11-01T15:13:57+09:001320128037フォーム
https://w.atwiki.jp/ac1226/pages/14.html
***表示画面で切り替え
Private Sub cmd印刷_Click()
On Error GoTo Err_cmd印刷_Click
strFrm = Forms(1).Caption
If strFrm = "" Then
strFrm = Forms(2).Caption
End If
If strFrm = "印刷メニュー" Then
strRpt = Reports(0).Name
End If
If strFrm = "標題1" Then
DoCmd.OpenReport "レポート1", acViewPreview
DoCmd.Close acForm, "フォーム1"
ElseIf strRpt = "レポート1" Then
DoCmd.OpenReport "レポート1", acViewNormal
ElseIf strRpt = "レポート2" Then
DoCmd.OpenReport "レポート2", acViewNormal
ElseIf strFrm = "標題2" Then
DoCmd.OpenReport "レポート1", acViewPreview
DoCmd.Close acForm, "フォーム1"
End If
Exit_cmd印刷_Click:
Exit Sub
Err_cmd印刷_Click:
MsgBox Err.Description
Resume Exit_cmd印刷_Click
End Sub
***チラつき制御
DoCmd.Echo False
DoCmd.OpenForm "F_1"
DoCmd.Echo True
***フォーム[×]で閉じる時
Private Sub Form_Unload(Cancel As Integer)
If MsgBox("「AAA」を終了しますか?", vbYesNo + vbQuestion) = vbYes Then
DoCmd.Quit
Else
Cancel = -1
End If
End Sub
***別フォームへ
1. DoCmd.OpenForm "f_別フォーム", , , "[項目]=Forms![f_main]![項目]"
2. DoCmd.OpenForm "f_別フォーム", , , "ID=" & ID
***フォーカスの位置確認
MsgBox Me.ActiveControl.Name
***別フォームのコントロール
Forms![別フォーム].chkコントロール = False
Forms![別フォーム].Controls(変数(i)).Enabled = False
Forms(変数)!Controls(変数).Enabled = False 2011-10-31T16:15:56+09:001320045356レコード
https://w.atwiki.jp/ac1226/pages/23.html
***全レコードを削除
Dim strSQL As String
DoCmd.SetWarnings False
strSQL = "DELETE * FROM テーブル名"
DoCmd.RunSQL strSQL
***空白行削除
Private Sub Form_AfterUpdate()
If IsNull(Me.テキストボックス.Value) Then
DoCmd.SetWarnings False
DoCmd.RunCommand acCmdDeleteRecord
DoCmd.SetWarnings True
End If
End Sub
***カレントレコードの背景色(帳票フォーム)
非連結テキストボックス[txtID]作成、フォームヘッダーに置く
条件書式 式:[txtID]=[ID]
Private Sub Form_Current()
Me.txtID = Me.ID
End Sub
***空白がある時、次のレコードに移動させない
Private Sub Form_BeforeUpdate(Cancel As Integer)
If IsNull(Me.A) Or IsNull(Me.B) Or IsNull(Me.C) Then
MsgBox "未入力があります"
Cancel = True
End If
End Sub
2011-10-19T10:41:23+09:001318988483タブ
https://w.atwiki.jp/ac1226/pages/13.html
***ページ切り替え風
Private Sub オプショングループ_Click()
Me.Ltab.Value = Me.オプショングループ
Me.Dtab.Value = Me.オプショングループ
End Sub
***セットフォーカス
Me.タブ.Pages("AAA).SetFocus 2011-09-07T18:31:21+09:001315387881サブ
https://w.atwiki.jp/ac1226/pages/19.html
***メインフォーム&サブフォームの編集
メインフォームに入力して、レコード保存されないと、サブフォームに入力できない。
対処1:メインフォームもサブフォームに変える
***サブフォーム間の移動
<f_sFrm1>
Private Sub 項目_LostFocus()
Parent!f_sFrm2.SetFocus
Parent!f_sFrm2.Form.Controls("項目").SetFocus
End Sub
<f_sFrm2>
Private Sub 項目_LostFocus()
Parent!cmdボタン.SetFocus
End Sub
***サブフォームのコントロールへフォーカス
With Me.サブフォーム
.SetFocus
.Form.txt項目.SetFocus
End With 2011-09-07T16:10:22+09:001315379422