和暦から西暦へ


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イベントにセットする

金額の計算--必ずCcurで囲むこと

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)

日付

手形番号 = '" & Me.手形番号 & "'

まず、表示したくない項目の前に、%を付ける
  例)  担当者テーブル
       担当者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----

コンポボックスの2列目の表示方法 

実際のフオームのプロシジャーに作成
参考
合わせておくこと

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コントロールの条件を

パスワード入力方法

LIKE文(MDB)

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 で対応

入金日 = #" & Me.選択日 & "#

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は無視される

true,falseは、数字扱いとする

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

CD = " & Me.項 & "

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
動作に必要な機能は、参照設定で、チエックを入れておくこと

NZ関数とIIF関数

数字

まず、表示したくない項目の前に、*を付ける
  例)  担当者テーブル
       担当者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を使用する場合