VBA

*プロシージャー
*ストアードプロシジャー
  * フアンクション
  
  *プライベート
*パブリック		  
参照設定



*動作に必要な機能は、参照設定で、チエックを入れておくこと
*使用環境に、合わせてActiveXコントロールの条件をあわす
*EXCELのライブラリーは、使用環境に合うバージョンに設定しないで、レイトバイデングによりEXCELのバージョンに依存しない方法をとること
 
 
一般  変数 *  Dim ?? As で型を指定

As以後を指定しない場合はバリアント型		    
   定数    
  引数    
*実際の開発は各オブジェクトのプロパテイにイベントなどを設定して作る
*フオームとレポートのプロシジャ-は一般的にはプライベートプロシージャーにより機能させる
*テキストエデッタの活用
メモ帳でもよいが文字数、改行などの表示がないので、専用のテキストエデッタを使用すること
*NULLとスペース
見た目は違いが判らないにで、注意すること

スペースも文字の一種
NULLはデータが無くからっぽ
  
*全角のスペース
特に、全角のスペースは、""の中以外では使用しないこと
  
*クエリ-のＳＱＬ文はＶＢＡのＳＱＬ文には使用できない
  

一般

 		  

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

  
 

日付


 		  

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

    
 

数字

 

ＣＤ = " & Me.項 & "

    
   

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

  自治会会計  
 

ＬＩＫＥ文（ＭＤＢ）

 		  WHERE お客様名 like '" & a & "%" & "'    
 ＮＺ関数とＩＩＦ関数
 		 A = Nz(Me.詳細子.Form.小計.Value, 0)

A = IIf(IsNull(Me.詳細子.Form.小計.Value), 0, Me.詳細子.Form.小計.Value)
 例えば、伝票番号などのデータをテーブルに登録時、
データ格納後、見ると半角スペースが勝手にデータの先頭に入っていることがある
　　　----trim で対応 

          rs4("伝票") = Trim(yy)

          rs4("買掛先CD") = Me.買掛先CD

          rs4("買掛会社") = Me.買掛先名

          rs4.Update

          rs4.Close
 日付が空白の場合の対応   

  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.種類 & "',売掛先ＣＤ = '" & Me.売掛先ＣＤ & "',売掛先名 = '" & Me.売掛先名 & "',裏書先 = '" & Me.裏書先 & "',振出日 = " & a & ",入金期日 = " & b & ",入金銀行 = '" & Me.入金銀行 & "',裏書日 = " & c & ",金額 = '" & Me.金額 & "' where 手形番号 = '" & Me.手形番号 & "'"

 

      .CommandType = adCmdText

       .Execute

      End With

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

 

Dim a As Currency

Dim b As Currency

 a = Me.入金支払金額

 b = Me.補正

 

 Me.実金額 = CCur(a + b)
 コンポボックスの２列目の表示方法 

Private Sub 得意先コード_AfterUpdate()

　'得意先コードコンボボックスの更新後処理

　With Me!得意先コード

　'コンボボックスの２列目を得意先名テキストボックスに代入

　Me!得意先名 = .Column(1)

　'コンボボックスの３列目を得意先名テキストボックスに代入

　Me!担当者名 = .Column(2)

　End With

SQLsvrer接続時　データ登録などで、テーブル側の桁数を見てる場合がある

(ADP-専用）

 		  

　Ｔrim　を使用しないと　データ登録、更新ができない

自分のPCのID取得方法

 

標準モジュールにAPI関数を作成

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

実際のフオームのプロシジャーに作成

Private Sub PC_Click()

Dim A

A = GetMyComputerName()

Me.PC = A

End Sub

ＡＤＯでの接続例----通常接続

  

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

ＡＤＯでの接続例----接続時にオープンする

    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
 レコードセット時、フオームに反映した後、データ修正が不可----すべてのデータを反映できる 

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

INSERT INTO文で、別な方法を列記

 

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

（注意）　cur2は、レコ－ドセットの変数、　rec(23) などは、配列を使用した場合のデータ変数　をあらわす。

レコードセット時、フオームに反映した後、データ修正が可能

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

バリューを使用する

更新、削除などをクエリーで、処理したい場合、ＡＣＣＥＳＳのメッセイジを出ないようにする

DoCmd.SetWarnings False

条件なして、テーブルデータのデータ削除

With cmd

.CommandText = "DELETE * FROM 仮オーダ"

.CommandType = adCmdText

.Execute

End With
 ADP (SQLserver接続）で、ストア－ドプロシジャーを使用して、DoCmdを使用する場合

(ADP-専用）

DoCmd.SetWarnings False

DoCmd.OpenStoredProcedure "dbo.delete_一時売上_1"

ストアードプロシジャーの前に、dbo. を追記すること
 コンポボックスのデータで、クエリを使用しない場合、Ｌoadイベントにセットする

Private Sub Form_Load()

 Me.科目上.RowSourceType = "Value List"

 Me.科目上.RowSource = "費用;収益"

 Me.税区分.RowSourceType = "Value List"

 Me.税区分.RowSource = "外税;内税"

 Me.Calendar4.Value = Date

End Sub

カレンダーコントロールの日付をフォームを開く時、セットする場合

Open()にDoCmd.Maximizeがあると、Me.Calendar5.Valueは無視される

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

印刷のプレビューで、印刷をするかしないかを確認

        DoCmd.OpenReport "入金一覧表", acPreview

           If MsgBox("印刷してもよいですか", vbYesNo) = vbNo Then

              

             DoCmd.Close

            Else

   On Error Resume Next    

              DoCmd.RunCommand acCmdPrint

              DoCmd.Close

           End If

非連結でレポートを作成する場合（ＭＤＢ）----Set Me.Recordset = rs　は使用できない

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 = "買掛先ＣＤ"

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

途中で、プリンタを切り替えて印刷する

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