和暦から西暦へ
P側
yss = Me.年月.Value & "01月01日" ' 平成26年01月01日
Call yzseireki(yss, ysa, ysb, ysc)
y = Year(ysa & "/" & ysb & "/" & ysc)
xss = Me.OpenArgs & "20日" ' H26年01月20日
Call xzseireki(xss, xsa, xsb, xsc)
yy = Year(xsa & "/" & xsb & "/" & 20)
MM = Month(xsa & "/" & xsb & "/" & 20)
F側
Public Function xzseireki(xss As Variant, xsa As Variant, xsb As Variant, xsc As Variant) As Variant
Dim b
Dim c
Dim d
Dim x
Dim cc
Dim dd
Dim y
Dim xx As Long
Dim yy As Long
Dim zz As Long
b = Left(xss, 1)
zz = InStr(1, xss, "年")
Dim cn As New ADODB.Connection
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Set cn = CurrentProject.Connection
rs.CursorType = adOpenStatic
rs.LockType = adLockOptimistic
rs.LockType = adLockOptimistic
rs.Open "SELECT * from 元号 where 略 = '" & b & "'", cn, , , adCmdText
If Not rs.EOF = True Then
d = rs.Fields("始年月日")
c = rs.Fields("略")
xx = Val(Left(d, 4))
If zz = 3 Then
yy = Val(Mid(xss, 2, 1))
Else
yy = Val(Mid(xss, 2, 2))
End If
x = Year(d) + yy - 1
xsa = x
If zz = 3 Then
xsb = Mid(xss, 4, 2)
xsc = Mid(xss, 7, 2)
Else
xsb = Mid(xss, 5, 2)
xsc = Mid(xss, 8, 2)
End If
Else
End If
End Function
Public Function yzseireki(yss As Variant, ysa As Variant, ysb As Variant, ysc As Variant) As Variant
Dim b
Dim c
Dim d
Dim x
Dim cc
Dim dd
Dim y
Dim xx As Long
Dim yy As Long
Dim zz As Long
b = Left(yss, 2)
zz = InStr(1, yss, "年")
Dim cn As New ADODB.Connection
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Set cn = CurrentProject.Connection
rs.CursorType = adOpenStatic
rs.LockType = adLockOptimistic
rs.LockType = adLockOptimistic
rs.Open "SELECT * from 元号 where 元号 = '" & b & "'", cn, , , adCmdText
If Not rs.EOF = True Then
d = rs.Fields("始年月日")
c = rs.Fields("元号")
xx = Val(Left(d, 4))
If zz = 4 Then
yy = Val(Mid(yss, 3, 1))
Else
yy = Val(Mid(yss, 3, 2))
End If
x = Year(d) + yy - 1
ysa = x
If zz = 4 Then
ysb = Mid(yss, 5, 2)
ysc = Mid(yss, 8, 2)
Else
ysb = Mid(yss, 6, 2)
ysc = Mid(yss, 9, 2)
End If
Else
End If
End Function
ダイヤログボックスを用いて、色々なフアイルを検出する
標準プロシジャーに設定
'【API宣言部】
Public Declare Function
GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA"
(pOpenfilename As OPENFILENAME) As Long
'pOpenFileName構造体(ユーザー定義型)の宣言
Type OPENFILENAME
lStructSize
As Long '構造体のサイズ
hwndOwner As Long
'ダイアログを所有するウインドウハンドル
hInstance As Long 'アプリケーションインスタンス
lpstrFilter
As String 'フィルタ
lpstrCustomFilter As Long
'ユーザ定義フィルタ
nMaxCustrFilter
As Long 'ユーザ定義フィルタのバッファサイズ
nFilterIndex As Long
'デフォルトフィルタのインデックス
lpstrFile As String '選択されたファイル名
nMaxFile
As Long 'ファイル名のバッファ
lpstrFileTitle As String
'選択されたファイル名のタイトル
nMaxFileTitle As Long
'ファイル名のタイトルのバッファ
lpstrInitialDir
As String '初期ディレクトリ
lpstrTitle As String
'ダイアログボックスのタイトル
Flags
As Long 'オプション
nFileOffset As Integer
'ファイル名の最後の「\」までのオフセット値
nFileExtension As Integer
'拡張子までのオフセット値
lpstrDefExt
As String 'デフォルトの拡張子
lCustrData As Long
'OSがフック関数に渡すアプリ定義のデータ
lpfnHook
As Long 'メッセージを処理するフック関数
' へのポインタ
lpTemplateName As Long
End
Type
'定数宣言
'複数のファイルを選択可能に
Public
Const OFN_ALLOWMULTISELECT = &H200 'ファイルが存在しなかった場合、新規作成するかどうか表示
Public Const OFN_CREATEPROMPT =
&H2000 'エクスプローラ形式のダイアログを使用
Public Const OFN_EXPLORER =
&H80000 '存在しないファイル名を入力不可に
Public Const OFN_FILEMUSTEXIST =
&H1000
'「読み取り専用」チェックボックスを非表示
Public Const OFN_HIDEREADONLY =
&H4 'カレントディレクトリをダイアログのカレントディレクトリにする
Public
Const OFN_NOCHANGEDIR = &H8
Public Const OFN_NODEREFERENCELINKS
= &H100000 'ネットワークコンピュータを非表示に
Public
Const OFN_NONETWORKBUTTON = &H20000
Public Const OFN_NOREADONLYRETURN =
&H8000
Public Const OFN_NOVALIDATE =
&H100 'ファイルが存在していた場合、上書きを問い合わせる
Public
Const OFN_OVERWRITEPROMPT = &H2 '有効なパス名のみを入力可能に
Public Const OFN_PATHMUSTEXIST =
&H800 '「読み取り専用」チェックボックスをオンにする
Public
Const OFN_READONLY = &H1 '「ヘルプ」ボタンの表示
Public Const OFN_SHOWHELP =
&H10
'拡張子がデフォルトの拡張子と異なる場合に設定されるフラグ
Public
Const OFN_EXTENSIONDIFFERENT = &H400
'【機能】
'
コモンダイアログを表示し、選択ファイルのフルパスを取得
'【戻り値】
'
選択したファイルのフルパス文字列
Public Function
GetFileName()
As String
Dim pOpenfilename As OPENFILENAME
Dim
lngRet As Long
'Accessアプリケーションのハンドルを取得
pOpenfilename.hwndOwner =
Application.hWndAccessApp
pOpenfilename.hInstance = 0
'ファイルフィルタの設定
pOpenfilename.lpstrFilter =
"全てのファイル (*.*)" & String(1, vbNullChar) & "*.*"
& String(2, vbNullChar)
'
pOpenfilename.lpstrFilter = "Accessファイル (*.mdb)" & String(1,
vbNullChar) & "*.mdb" & String(2, vbNullChar)
pOpenfilename.lpstrCustomFilter = 0
pOpenfilename.nMaxCustrFilter = 0
pOpenfilename.nFilterIndex = 1
pOpenfilename.lpstrFile
= String(511, vbNullChar)
pOpenfilename.nMaxFile = 511
pOpenfilename.lpstrFileTitle
= String(512, vbNullChar)
pOpenfilename.nMaxFileTitle = 511
pOpenfilename.lpstrInitialDir =
String(1, vbNullChar)
pOpenfilename.lpstrTitle
= String(1, vbNullChar)
pOpenfilename.nFileOffset = 0
pOpenfilename.nFileExtension = 0
pOpenfilename.lpstrDefExt
= String(1, vbNullChar)
pOpenfilename.lCustrData = 0
pOpenfilename.lpfnHook
= 0
pOpenfilename.lpTemplateName = 0
pOpenfilename.lStructSize =
Len(pOpenfilename)
'読取専用ファイルを隠す
pOpenfilename.Flags =
OFN_HIDEREADONLY Or OFN_EXPLORER
lngRet =
GetOpenFileName(pOpenfilename)
GetFileName =
Left(pOpenfilename.lpstrFile, InStr(pOpenfilename.lpstrFile, vbNullChar) - 1)
End
Function
フオームのボタンに書く
Private Sub コマンド2_Click()
Me.名前
= GetFileName
DoCmd.RunCommand acCmdFormView
End Sub
ADPで、ストアードプロシジャーに依頼して、登録、更新などを実施する場合
If IsNull(Me.伝票番号) Then Exit Sub
DoCmd.RunCommand acCmdSaveRecord
Dim
conn As New ADODB.Connection
conn.ConnectionString =
CurrentProject.BaseConnectionString
conn.Open
conn.BeginTrans
Dim cmd As New ADODB.Command
Set
cmd.ActiveConnection = conn
With cmd
.CommandText
= "update_受注オーダ_1"
.CommandType = adCmdStoredProc
.Parameters.Refresh
.Parameters(1)
= Me.伝票番号
.Parameters(2) = Me.自社S
.Parameters(3)
= Me.メーカS
.Parameters(4) = Me.運送会社2
.Parameters(5) = Me.運送伝票2
.Parameters(6)
= Me.運送金額2
.Execute
End
With
conn.CommitTrans
MsgBox "オーダ修正しました"
(注意) パラメータの番号と、ストアプロシジャーのパラメータの番号が対応していること
If
IsNull(Me.登録) Then Exit Sub
If
Me.登録 = "" Then Exit Sub
If
IsNull(Me.認証) Then Exit Sub
If
Me.認証 = "" Then Exit Sub
If
IsNull(Me.新認証1) Then Exit Sub
If
Me.新認証1 = "" Then Exit Sub
If
IsNull(Me.新認証2) Then Exit Sub
If
Me.新認証2 = "" Then Exit Sub
Dim cn As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim rs As New ADODB.Recordset
Dim rs2 As New ADODB.Recordset
Set cn = CurrentProject.Connection
Set cmd.ActiveConnection = cn
Dim a
Dim b
Dim c
rs.Open "SELECT * from 管理者",
cn, , , adCmdText
If rs.EOF = True Then Exit Sub
a = rs.Fields("登録")
If Me.登録 <> a Then
MsgBox
"管理者のパスワードが合ってません。"
Exit Sub
End If
rs2.Open "SELECT * from PW", cn,
, , adCmdText
If rs2.EOF = True Then Exit Sub
' b = rs2.Fields("登録")
c = rs2.Fields("認証")
If Me.認証 <> c Then
MsgBox "現在のパスワードが合ってません。"
Exit Sub
End If
If Me.新認証1 <> Me.新認証2 Then
MsgBox "新しいのパスワードが合ってません。"
Exit Sub
End If
cn.BeginTrans
With cmd
.CommandText = "UPDATE PW SET 登録 =
'" & Me.登録 & "',認証 = '" & Me.新認証2 &
"'"
.CommandType = adCmdText
.Execute
End With
cn.CommitTrans
MsgBox "修正しました。"
cn.Close
If IsNull(Me.PW) Then Exit Sub
If
Me.PW = "" Then Exit Sub
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim cmd As New ADODB.Command
Set
conn = CurrentProject.Connection
Set cmd.ActiveConnection = conn
Dim a
rs.CursorLocation = adUseServer
rs.CursorType
= adOpenStatic
rs.LockType = adLockOptimistic
rs.Open "SELECT * from PW
", conn, , , adCmdText
If rs.EOF Then Exit Sub
a = rs.Fields("認証")
If Me.PW = a Then
DoCmd.OpenForm "サブメイン"
DoCmd.Close acForm, "PW入力M"
Else
MsgBox "パスワードが間違っています。"
Exit Sub
End If
Dim b
Dim c
Dim x As String
Dim y
c = Forms!支払手形支払期日予定表.[指定日].Value
If IsNull(c) Then Exit Sub
b = "and 完 = '" & 0 &
"'"
y = DateAdd("d", 3, c)
Dim cn
As ADODB.Connection
Dim rs6
As New ADODB.Recordset
Set cn = CurrentProject.Connection
rs6.CursorLocation = adUseServer
rs6.CursorType = adOpenStatic
rs6.LockType = adLockOptimistic
rs6.Open "SELECT * from 支払手形
WHERE 支払期日 >= #" & y & "# " & b & "
ORDER BY 支払期日 DESC", cn, , , adCmdText
If
rs6.EOF Then Exit Sub
x = "SELECT * from 支払手形 WHERE
支払期日 >= #" & y & "# " & b & " ORDER BY
支払期日 DESC"
Me![手形番号].ControlSource
= "手形番号"
Me![種類].ControlSource =
"種類"
Me![買掛先CD].ControlSource =
"買掛先CD"
Me![買掛先名].ControlSource
= "買掛先名"
Me![裏書先].ControlSource =
"裏書先"
Me![振出日].ControlSource
= "振出日"
Me![支払期日].ControlSource =
"支払期日"
Me![支払銀行].ControlSource =
"支払銀行"
Me![裏書日].ControlSource
= "裏書日"
Me![顛末日].ControlSource =
"顛末日"
Me![顛末区分].ControlSource
= "顛末区分"
Me![金額].ControlSource =
"金額"
Me![決済金額].ControlSource =
"決済金額"
Me![補正].ControlSource
= "補正"
Me![補正内訳].ControlSource =
"補正内訳"
Me![完].ControlSource =
"完"
Me![更新日].ControlSource
= "更新日"
Me.RecordSource = x
If IsNull(Me.伝票番号) Then Exit Sub
DoCmd.RunCommand acCmdSaveRecord
Dim conn As New ADODB.Connection
conn.ConnectionString = CurrentProject.BaseConnectionString
conn.Open
conn.BeginTrans
Dim cmd As New ADODB.Command
Set cmd.ActiveConnection = conn
With cmd
.CommandText = "update_受注オーダ_1"
.CommandType = adCmdStoredProc
.Parameters.Refresh
.Parameters(1) = Me.伝票番号
.Parameters(2) = Me.自社S
.Parameters(3) = Me.メーカS
.Parameters(4) = Me.運送会社2
.Parameters(5) = Me.運送伝票2
.Parameters(6) = Me.運送金額2
.Execute
End With
conn.CommitTrans
MsgBox "オーダ修正しました"
DoCmd.Close acForm, "修理依頼日入力"
DoCmd.OpenForm "修理依頼日入力"
7 MDBで、削除したい場合
With cmd
.CommandText = "DELETE * FROM 仮オーダ"
.CommandType = adCmdText
.Execute
End With
On Error Resume Next
DoCmd.SetWarnings False
rs6.Open "SELECT * from 一時売上", CN, , , adCmdText
If rs6.EOF = True Then Exit Sub
rs6.MoveFirst
Do Until rs6.EOF
Set rs10 = New ADODB.Recordset
rs10.Open "SELECT * from 商品M where 商品コード = '" & rs6.Fields("商品コード") & "'", CN, , , adCmdText
rs7.Open "売上", CN, adOpenKeyset, adLockOptimistic, adCmdTableDirect
rs7.AddNew
rs7("連番") = db
rs7("店舗コード") = rs6.Fields("店舗コード")
rs7("PC") = rs6.Fields("PC")
rs7("商品コード") = rs6.Fields("商品コード")
rs7("JAN") = rs6.Fields("JAN")
rs7("担当ID") = rs6.Fields("担当ID")
rs7("品名") = rs6.Fields("品名")
rs7("数量") = rs6.Fields("数量")
rs7("単価") = rs6.Fields("単価")
rs7("金額") = rs6.Fields("金額")
rs7("取引日") = rs6.Fields("取引日")
rs7("仕入単価") = IIf(rs6.Fields("品名") = "値引き", 0, rs6.Fields("仕入単価"))
rs7("大分類") = IIf(rs6.Fields("品名") = "値引き", "", rs10.Fields("大分類"))
rs7("仕入単価税抜") = IIf(rs6.Fields("品名") = "値引き", 0, rs10.Fields("仕入単価税抜"))
rs7("型番") = IIf(rs6.Fields("品名") = "値引き", "", rs10.Fields("型番"))
rs7("値引") = IIf(IsNull(rs6.Fields("値引")), 0, rs6.Fields("値引"))
rs7.Update
rs7.Close
ca = rs6.Fields("数量")
Set rs8 = New ADODB.Recordset
rs8.Open "SELECT * from 在庫 where 商品コード = '" & rs6.Fields("商品コード") & "'", CN, , , adCmdText
If Not rs8.EOF Then
x = rs8.Fields("在庫数")
x = x - ca
With cmd
.CommandText = "UPDATE 在庫 SET 在庫数 = " & x & " where 商品コード = '" & rs6.Fields("商品コード") & "'"
.CommandType = adCmdText
.Execute
End With
rs9.Open "在庫履歴", CN, adOpenKeyset, adLockOptimistic, adCmdTableDirect
rs9.AddNew
rs9("商品コード") = rs6.Fields("商品コード")
rs9("売価") = rs10.Fields("売価")
rs9("JAN") = rs6.Fields("JAN")
rs9("品名") = rs6.Fields("品名")
rs9("メーカ") = rs10.Fields("メーカ")
rs9("取引先コード") = rs10.Fields("取引先コード")
rs9("発注単価") = rs10.Fields("仕入単価")
rs9("型番") = rs6.Fields("型番")
rs9("セット区分") = rs10.Fields("セット区分")
rs9("定番") = rs10.Fields("定番")
rs9("棚番") = rs10.Fields("棚番")
rs9("税区分") = rs10.Fields("税区分")
rs9("分類") = rs10.Fields("分類")
rs9("色") = rs10.Fields("色")
rs9("更新日") = Format(n, "yyyy/mm/dd")
rs9("適正在庫") = rs10.Fields("適正在庫")
rs9("出庫数") = ca
rs9("出庫先") = "POS売上"
rs9.Update
rs9.Close
End If
rs6.MoveNext
Loop
プロシジャーコード他
非連結でレポートを作成する場合(MDB)----Set
Me.Recordset = rs は使用できない
a = Me.振出日.Value
b = Me.入金期日.Value
c = Me.裏書日.Value
If IsNull(Me.振出日) = True Then a = "Null" Else a =
"#" & Me.振出日 & "#"
If IsNull(Me.入金期日) = True Then b = "Null" Else b =
"#" & Me.入金期日 & "#"
If IsNull(Me.裏書日) = True Then c = "Null" Else c =
"#" & Me.裏書日 & "#"
With cmd
.CommandText = "UPDATE 受取手形 SET 種類
= '" & Me.種類 & "',売掛先CD = '" & Me.売掛先CD &
"',売掛先名 = '" & Me.売掛先名 & "',裏書先 = '" & Me.裏書先
& "',振出日
= " & a & ",入金期日 = " & b &
",入金銀行 = '" & Me.入金銀行 & "',裏書日 = " & c &
",金額 = '" & Me.金額 & "' where 手形番号 = '" &
Me.手形番号 & "'"
.CommandType = adCmdText
.Execute
End With
23 コンボボックスで、表示したくない項目を対象外にする方法----MDB
プロシジャーとDBとの関係
Dim ?? As で型を指定
JIS----
★プロシージャー
特に、全角のスペースは、""の中以外では使用しないこと
★SQL
As以後を指定しない場合はバリアント型
★効ないイベントがある
★引数
SHIFT_JIS----
RS8 がオープンできない場合
ODBC接続などの場合は文字化けなどを注意すること
標準モジュールにAPI関数を作成
コンポボックスのデータで、クエリを使用しない場合、Loadイベントにセットする
Private Sub Form_Load()
Me.運送会社A.RowSourceType = "Value List"
Me.運送会社A.RowSource = "ヤマト運輸;佐川運輸"
End Sub
★ストアードプロシジャー
コンポボックスのデータで、クエリを使用しない場合、Loadイベントにセットする
Private Sub Form_Load()
Me.科目上.RowSourceType = "Value List"
Me.科目上.RowSource = "費用;収益"
Me.税区分.RowSourceType = "Value List"
Me.税区分.RowSource = "外税;内税"
Me.Calendar4.Value = Date
End Sub
-----------------------------------------------------
Private Sub Form_Open(Cancel As
Integer)
Dim hMenu As Long
'システムメニューのハンドルを取得
hMenu =
GetSystemMenu(Application.hWndAccessApp, 0)
'閉じるボタンを無効にする
DeleteMenu hMenu, SC_CLOSE, MF_BYCOMMAND
'メニューを再描画
' DrawMenuBar Application.hWndAccessApp
DoCmd.Maximize
------------------------------------------------------
Private Sub Form_Load()
Me.chk_B = False
Me.Calendar5.Value = Date --------- 効かない
End
Sub
---------------------------------------------------
rs4("伝票") = Trim(yy)
rs4("買掛先CD") = Me.買掛先CD
rs4("買掛会社") = Me.買掛先名
rs4.Update
rs4.Close
A = Nz(Me.詳細子.Form.小計.Value, 0)
A =
IIf(IsNull(Me.詳細子.Form.小計.Value), 0, Me.詳細子.Form.小計.Value)
まず、表示したくない項目の前に、%を付ける
例) 担当者テーブル
担当者ID(キー項目)------そのまま
担当者名−−− % 佐藤
コンボボックスのSQL文で、 WHERE ((担当者名 Not Like "%*"))
------ Set rs8 を入れると、解決する
6 レコードセット時、フオームに反映した後、データ修正が可能----SQL文の内容によっては、すべてのデータを反映できない
★SQL文の注意事項
NULLはデータが無くからっぽ
スペースも文字の一種
見た目は違いが判らないにで、注意すること
★テキストエデッタの活用
ADO
データベースとの接続するコントロール
機能させる
★定数
★変数
標準モジュール
Unicode-----
28 do loop の使用例
UTF-8----
Set rs8 = New ADODB.Recordset
rs8.Open "SELECT last(ID) as ed from 一時売上 where 種類 = '" & 1 & "'", CN, , , adCmdText
I = rs8.Fields("ed")
--------バリューを使用する
ASCII----
実際のフオームのプロシジャーに作成
参考
合わせておくこと
Option Compare Database
Declare Function GetComputerName Lib "kernel32" Alias _
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Public Function GetMyComputerName() As String
'自分のパソコンのコンピュータ名を返す
Dim strCmptrNameBuff As String * 21
'API関数によってコンピューター名を取得します
'コンピュータ名は変数strCmptrNameBuffに返されます
GetComputerName strCmptrNameBuff, Len(strCmptrNameBuff)
'後続のNullを取り除いて返り値を設定します
GetMyComputerName = Left$(strCmptrNameBuff, InStr(strCmptrNameBuff, vbNullChar) - 1)
End Function
SQLsvrer接続時 データ登録などで、テーブル側の桁数を見てる場合がある
WHERE お客様名 like '" & a
& "%" & "'
Dim msg As String
Dim pw As String
Dim a
msg = "パスワードを入力して下さい"
pw = InputBox(msg, "パスワード入力", "*****")
'a = IsNumeric(pw)
If pw = "ABCDE" Then
DoCmd.OpenForm "受注オーダ削除"
DoCmd.Close acForm, "メイン"
Else
MsgBox "パスワードが間違っています。"
Exit Sub
End If
異なるので、使用するActiveXコントロールの条件を
DoCmd.OpenReport "請求書", acPreview
If MsgBox("印刷してもよいですか", vbYesNo) = vbNo Then
DoCmd.Close
Else
On Error Resume Next
DoCmd.RunCommand acCmdPrint
DoCmd.Close
End If
この場合、専用のビューを作成しておくこと
Dim CN As ADODB.Connection
Dim rs As New ADODB.Recordset
Dim rs2 As New ADODB.Recordset
Dim rs3 As New ADODB.Recordset
Dim rs4 As New ADODB.Recordset
Dim rs5 As New ADODB.Recordset
Dim rs6 As New ADODB.Recordset
Dim rs7 As New ADODB.Recordset
Dim rs8 As New ADODB.Recordset
Dim cmd As New ADODB.Command
Set CN = CurrentProject.Connection
Set cmd.ActiveConnection = CN
(注意) cur2は、レコ−ドセットの変数、 rec(23) などは、配列を使用した場合のデータ変数 をあらわす。
-----データ更新時、エラーが出ないようにする
−−−−−−コントロールソースを使用する
★フアンクション
do loop の使用例
rs.Open
"SELECT * from 入金元帳 WHERE 手形番号 = '" & Me.手形番号 &
"'", conn, , , adCmdText
rs.MoveFirst
Do Until rs.EOF
x = rs.Fields("CD").Value
With cmd
.CommandText = "UPDATE 入金元帳 SET 手形完
= '" & 2 & "' WHERE CD = " & x & ""
.CommandType = adCmdText
.Execute
End With
rs.MoveNext
Loop
Forms!受取手形決済修正選択.Requery
MsgBox "修正しました"
例えば、伝票番号などのデータをテーブルに登録時、データ格納後、見ると半角スペースが勝手にデータの先頭に入っていることがある ----trim
で対応
22 ADPで、ストアードプロシジャーに依頼して、登録、更新などを実施する場合
DoCmd.SetWarnings False
DoCmd.OutputTo acOutputStoredProcedure, "EXEC [SP売掛オーダ抽出] '" & Me!開始日 & "','" & Me!終了日 & "'", acFormatXLS, C:
MsgBox "エクスポート完了"
19 MDBと接続方法
14 INSERT INTO文で、一般的でない別な方法を列記
15 addnewを使用した登録方法
rs.Open "SELECT * from 受注オーダ where 受注番号 = '" & Me.受注番号A & "'", CN, , , adCmdText
If rs.EOF = True Then Exit Sub
Me.[受注番号].Value = rs.Fields("受注番号")
Me.[不動産先コード].Value = rs.Fields("不動産先コード")
Me.[顧客].Value = rs.Fields("顧客")
Me.[契約日].Value = rs.Fields("契約日")
Me.[着工日].Value = rs.Fields("着工日")
Me.Requery
5 レコードセット時、フオームに反映した後、データ修正が不可----すべてのデータを反映できる
DoCmd.SetWarnings False
DoCmd.OpenStoredProcedure "dbo.delete_一時売上_1"
----ストアードプロシジャーの前に、dbo. を追記すること
クエリ-のSQL文はVBAのSQL文には使用できない
★全角のスペース
メモ帳でもよいが文字数、改行などの表示がないので、専用のテキストエデッタを使用すること
DAO
★そのプロシジャーは一般的には次のフローとなる
★実際の開発は各オブジェクトのプロパテイにイベントなどを設定して作る
★プロシジャーの相関図
アクセスはUnicodeを使用している
2 自分のPCのID取得方法
Trim を使用しないと データ登録、更新ができない
DoCmd.RunCommandacCmdSaveRecord
Dim CN As ADODB.Connection
Dim rs3 As New ADODB.Recordset
Dim rs As New ADODB.Recordset
Dim rs7 As New ADODB.Recordset
Dim cmd As New ADODB.Command
Set CN = CurrentProject.Connection
Set cmd.ActiveConnection = CN
使用環境では例えばEXCELのバージョンによって、ライブラリーの版数が
カレンダーコントロールの日付をフォームを開く時、セットする場合
Open()にDoCmd.Maximizeがあると、Me.Calendar5.Valueは無視される
13 レコードセットを複数同時に使用して動作させる時、競合、してオープンできない場合の処理方法
11 パスワードの設定方法
Public Declare Function GetSystemMenu Lib "user32" _
(ByVal hwnd As Long, ByVal bRevert As Long) As Long
Public Declare Function DeleteMenu Lib "user32" _
(ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Public Declare Function DrawMenuBar Lib "user32" _
(ByVal hwnd As Long) As Long
Public Const MF_BYCOMMAND = &H0
Public Const SC_CLOSE = &HF060
-------接続時のみオ−プンをする
★イベント
★プライベート
条件なして、テーブルデータのデータ削除
With cmd
.CommandText
= "DELETE * FROM 仮オーダ"
.CommandType = adCmdText
.Execute
End With
1.コンポボックスの2列目の表示方法
16 LIKE抽出のSQL文
17 MDBで、クエリ抽出をEXCELに、エキスポート
cur2.Execute "INSERT INTO 一時(伝票番号,連絡,お客様,品名,受付日,依頼番号,担当,仕事,会社) VALUES('" & rec(0) & "','" & rec(12) & "','" & rec(6) & "','" & rec(17) & "',#" & rec(23) & "#,'" & rec(64) & "','" & rec(38) & "','" & rec(65) & "','" & rec(66) & "')", adCmdText + adExecuteNoRecords
10 途中で、プリンタを切り替えて印刷する
rs.Open "SELECT 伝票番号,お客様,受付日,品名,型番,メーカ,出荷日 from
受注オーダ WHERE 伝票番号= '" & a & "'", conn, ,
, adCmdText
If rs.EOF Then Exit Sub
Me![伝票番号].ControlSource = "伝票番号"
Me![お客様].ControlSource = "お客様"
Me![受付日].ControlSource = "受付日"
Me![品名].ControlSource = "品名"
Me![メーカ].ControlSource = "メーカ"
Me![型番].ControlSource = "型番"
Me![出荷日].ControlSource = "出荷日"
Set Me.Recordset = rs
Me.Requery
★NULLとスペース
★ADOとDAO
★フオームとレポートのプロシジャ-は一般的にはプライベートプロシージャーにより
★パブリック
Private Sub 得意先コード_AfterUpdate()
'得意先コードコンボボックスの更新後処理
With Me!得意先コード
'コンボボックスの2列目を得意先名テキストボックスに代入
Me!得意先名 = .Column(1)
'コンボボックスの3列目を得意先名テキストボックスに代入
Me!担当者名 = .Column(2)
End With
End Sub
24 コンボボックスで、表示したくない項目を対象外にする方法----ADP
(注意) この場合、フォームに開始日と終了日のコントロールを設定し、ストアードプロシジャーにもパラメータを設定して置くこと
DoCmd.SetWarnings False
DoCmd.TransferSpreadsheet acExport, 8, "受注オーダ経理クエリ",
"C:\経理データ.xls", True, ""
DoCmd.SetWarnings True
MsgBox "エクスポート完了"
18 ADP(SQLserver接続)で、クエリ抽出をエキスポート
Dim con As New ADODB.Connection
Set con = New ADODB.Connection
con.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=\\Serveraa\部品管理\部材管理DB.mdb"
20 SQLserverと接続方法
21 DBがオートナンバーにしていない場合、最大値の抽出( ADP)
Dim prtDefault As Printer
'現在のプリンタ設定を退避
Set prtDefault = Application.Printer
'選択されたプリンタの情報を設定
Set Application.Printer = Printers.Item(DeviceName & "SHARP AR-C260S SPDL-c")
'レポートを開く
DoCmd.OpenReport "日売上印刷"
'プリンタ設定を元に戻す
Set Application.Printer = prtDefault
DoCmd.Close
12 アクセスの画面で、閉じる(X) を 機能させない
rs.CursorLocation = adUseServer
rs.CursorType = adOpenStatic
rs.LockType = adLockOptimistic
rs2.Open "SELECT 注文番号 from 受注オーダ WHERE 注文番号 = '" & a & "'", CN, , , adCmdText
If Not rs2.EOF Then
If rs2.Fields("注文番号").Value = a Then
MsgBox "登録済みです。"
Exit Sub
End If
End If
rs.Open "受注オーダ", CN, adOpenKeyset, adLockOptimistic, adCmdTableDirect
rs.AddNew
rs("注文番号") = Me![注文番号]
rs("受付日") = Me![受付日]
rs("お客様") = Me![お客様]
rs("店舗担当") = Me![店舗担当]
rs("取引先コード") = Me![取引先コード]
rs("型番") = Me![型番]
rs("部品名") = Me![部品名]
rs("オーダ数") = Me![オーダ数]
'rs("備考") = Me![備考]
rs.Update
rs.Close
MsgBox "オーダ登録しました"
Me!注文番号.SetFocus
Me!注文番号.Text = ""
Me!部品名.SetFocus
Me!部品名.Text = ""
9 印刷のプレビューで、印刷をするかしないかを確認
Private Sub PC_Click()
Dim A
A = GetMyComputerName()
Me.PC = A
End Sub
実際のフオームのプロシジャーに作成
★参照設定とバージョン
Private Sub 得意先コード_AfterUpdate()
'得意先コードコンボボックスの更新後処理
With
Me!得意先コード
'コンボボックスの2列目を得意先名テキストボックスに代入
Me!得意先名 = .Column(1)
'コンボボックスの3列目を得意先名テキストボックスに代入
Me!担当者名 = .Column(2)
End With
DoCmd.SetWarnings False
DoCmd.OutputTo acOutputServerView, "顧客データ抽出", acFormatXLS, C:
MsgBox "エクスポート完了"
rs2.Open "SELECT * from 受注オーダ WHERE (連絡 like '" &
Me.連絡 & "%" & "')", CN, , , adCmdText
With cmd
.CommandText = "select MAX(子ID) from CTL子"
End With
Set rs3 = cmd.Execute("CTL子")
da = rs3.Fields(0).Value
da = da + 1
4 ADOで、DBに接続時------例2
EBCDIC----
Private Sub Form_Load()
Me.科目上.RowSourceType = "Value List"
Me.科目上.RowSource = "費用;収益"
Me.税区分.RowSourceType = "Value List"
Me.税区分.RowSource = "外税;内税"
Me.Calendar4.Value = Date
End Sub
Private Sub Form_Load()
'フォーム読み込み時
Dim hMenu As Long
'システムメニューのハンドルを取得
hMenu = GetSystemMenu(Application.hWndAccessApp, 0)
'閉じるボタンを無効にする
DeleteMenu hMenu, SC_CLOSE, MF_BYCOMMAND
'メニューを再描画
DrawMenuBar Application.hWndAccessApp
End Sub
--------ODBEで、接続しているので、カレントプロジュクトコネクションを使用
ストアプロシジャーに依頼時
−−−−−レコードセットと、コマンドの両方動作可能にするケース
★文字コード
更新、削除などをクエリーで、処理したい場合、ACCESSのメッセイジを出ないようにする
DoCmd.SetWarnings False
Dim a As Currency
Dim b
As Currency
a = Me.入金支払金額
b = Me.補正
Me.実金額 = CCur(a + b)
25 コンボボックスのバリューリストの保存場所
-----更新メッセイジを出さないようにする
3 ADOで、DBに接続時-----例1
動作に必要な機能は、参照設定で、チエックを入れておくこと
まず、表示したくない項目の前に、*を付ける
例) 担当者テーブル
担当者ID(キー項目)------そのまま
担当者名−−− * 佐藤
コンボボックスのSQL文で、 where (not (担当者名 like '*%'))
(注意) パラメータの番号と、ストアプロシジャーのパラメータ の番号が対応していること
Dim con As New ADODB.Connection
Set con = New ADODB.Connection
con.ConnectionString = "Provider=SQLOLEDB;Data Source=SERVERAA;Initial Catalog=在庫;User ID=s040;Password=shop;Integrated Security = SSPI;"
con.Open
標準モジュールにAPI関数を作成
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
conn.ConnectionString = CurrentProject.BaseConnectionString
conn.Open
Dim cmd As New ADODB.Command
Set cmd.ActiveConnection = conn
8 ADP (SQLserver接続)で、ストア−ドプロシジャーを使用して、DoCmdを使用する場合