【Access VBA】SQL Serverのテーブルを編集する

AccessからSQL Serverのテーブルを編集する

SQL Serverの「売上伝票」テーブルおよび「売上明細」テーブルのデータをAccessで取得し、修正を加えたのち、SQL Serverに保存します。

テーブルを準備する

SQL Serverで「sample」という名前のデータベースの中に「T売上伝票」、「T売上明細」、「TEMP売上伝票」、「TEMP売上明細」の4つのテーブルを用意しました。「T売上伝票」、「T売上明細」は生データを保存するテーブルであり、「TEMP売上伝票」、「TEMP売上明細」は一時的にAccessから編集後のデータを受け取るテーブルです。この一時テーブルからストアドプロシージャを使って、生データのテーブルにデータを書き込みます。
さらに「T売上伝票」の主キー値発番用に「T発番」という名前のテーブルを用意しました。
発番用のストアドプロシージャについては下記リンク先を参照してください。
【Access VBA】主キー値をSQL Serverから取得する - カットマンブログ
Accessには「WT売上伝票」、「WT売上明細」の2つのテーブルを用意しました。


「T売上伝票」、「T売上明細」の間に連鎖削除を設定しました。

SQL Serverにストアドプロシージャを準備する

SQL Serverに「import売上情報」という名前のストアドプロシージャを用意しました。
これにより一時テーブルのデータを生データのテーブルに書き込みます。

ALTER PROCEDURE [dbo].[import売上情報] 	
	
AS
BEGIN	
	SET NOCOUNT ON;
    BEGIN TRY
      BEGIN TRANSACTION
      --T売上伝票更新----------------------------------------------------	
	MERGE INTO [T売上伝票] AS A    
        USING
       (SELECT [伝票番号],[日付] FROM [TEMP売上伝票] WITH(TABLOCKX)) AS B 
        ON
        (A.[伝票番号] = B.[伝票番号])
        WHEN MATCHED THEN    
          UPDATE SET [日付] = B.[日付]        
        WHEN NOT MATCHED THEN
          INSERT ([伝票番号],[日付])
          VALUES (B.[伝票番号],B.[日付]);        
      ---------------------------------------------------------------
      --T売上明細更新-------------------------------------------------		
        MERGE INTO [T売上明細] AS C    
        USING    
        (SELECT [明細ID],[伝票番号],[商品コード],[数量],[削除]
        FROM [TEMP売上明細] WITH(TABLOCKX)) AS D
        ON    
        (C.[明細ID] = D.[明細ID])
        WHEN MATCHED AND D.[削除]=0 THEN
          UPDATE SET [商品コード] =D.[商品コード], [数量] = D.[数量]		            
        WHEN MATCHED AND D.[削除]=1 THEN   
	      DELETE
        WHEN NOT MATCHED AND D.[削除]=0 THEN
          INSERT ([伝票番号],[商品コード],[数量])
          VALUES (D.[伝票番号],D.[商品コード],D.[数量]);
      -------------------------------------------------------------------			
      COMMIT TRANSACTION 
      RETURN-1 
    END TRY

    BEGIN CATCH
      ROLLBACK TRANSACTION		
      RETURN 0
    END CATCH
END

SQL Serverに「SetID」という名前のストアドプロシージャを用意しました。これにより「売上伝票」の主キー値を発番します。以下に「SetID」のコードを記載します。

ALTER PROCEDURE [dbo].[SetID]	
	@ID int OUTPUT 
AS
BEGIN	
	SET NOCOUNT ON;    
	BEGIN TRY
		BEGIN TRANSACTION
			SELECT @ID=	連番 FROM T発番 WITH(TABLOCKX)
			UPDATE T発番 SET 連番=@ID+1
		COMMIT TRANSACTION 
		RETURN -1 
	END TRY

	BEGIN CATCH
		ROLLBACK TRANSACTION		
		RETURN 0
	END CATCH
END

リンクテーブルの作成

Accessで「TEMP売上伝票」と「TEMP売上明細」のリンクテーブルを作成しました。
作成方法は下記リンク先を参照してください。
【Access】SQL Serverのリンクテーブル作成 - カットマンブログ

選択クエリの作成

Accessで「Q売上明細」という名前の選択クエリを作成しました。サブフォームのレコードソースとして使用します。

フォームの準備

下のような「Fサンプル」という名前のフォームを作成しました。「伝票一覧」と「売上明細」はサブフォームです。「売上伝票」の部分には非連結のテキストボックス２つを配置しています。


「売上明細」サブフォームでは「伝票番号」と「削除」フィールドを非表示にして、以下の既定値を設定しました。

SQL Serverのテーブルから「売上伝票」と「売上明細」を取得するコードの記述

標準モジュールにAccessのテーブルをクリアし、SQL Serverのテーブルから売上伝票と売上明細を取得するプロシージャ「wtImport」を記述します。

Public Const strCN As String = "driver={ODBC Driver 17 for SQL Server};server=LAPTOP-114315\SQLEXPRESS;DATABASE=sample;uid=administrator;PWD=1111"
Public Sub wtImport(ByVal strWT As String, ByVal strSQL As String)
    Dim w_cn As New ADODB.Connection
    Set w_cn = CurrentProject.AccessConnection
    Dim w_cmd As New ADODB.Command
    w_cmd.ActiveConnection = w_cn
    w_cmd.CommandType = adCmdText
    w_cmd.CommandText = "DELETE FROM " & strWT
    w_cmd.Execute
    w_cmd.CommandText = "INSERT INTO " & strWT & " " & strSQL
    w_cmd.Execute
    Set w_cmd = Nothing
    w_cn.Close: Set w_cn = Nothing
End Sub

SQL Serverの「T売上伝票」から目的のデータを削除するコードの記述

標準モジュールにSQL Serverの「T売上伝票」から目的のデータを削除するプロシージャ「tDelete」を作成しました。

Public Sub tDelete(ByVal intSlipNo As Integer)
    Dim cn As New ADODB.Connection
    cn.Open strCN
    Dim cmd As New ADODB.Command
    cmd.ActiveConnection = cn
    cmd.CommandType = adCmdText
    cmd.CommandText = "DELETE FROM T売上伝票 WHERE 伝票番号=" & intSlipNo
    cmd.Execute
    Set cmd = Nothing
    cn.Close: Set cn = Nothing
End Sub

SQL Serverから主キー値を取得するコードの記述

標準モジュールにSQL Serverから主キー値を取得する関数「GetID」を作成しました。

Public Function GetID(ByRef n As Integer) As Boolean
    Dim cn As New ADODB.Connection
    cn.Open strCN
    Dim cmd As New ADODB.Command
    cmd.ActiveConnection = cn
    cmd.CommandType = adCmdStoredProc
    cmd.CommandText = "SetID"
    cmd.Parameters.Append cmd.CreateParameter(, adInteger, adParamReturnValue, , Null)
    cmd.Parameters.Append cmd.CreateParameter("@ID", adInteger, adParamOutput, , Null)
    cmd.Execute
    
    If CBool(cmd.Parameters(0).Value) Then
        n = cmd.Parameters("@ID").Value
        GetID = True
    Else
        MsgBox "エラーが発生しました。", vbExclamation, "確認"
        GetID = False
    End If
    Set cmd = Nothing
    cn.Close: Set cn = Nothing
End Function

Accessのテーブルをクリアするコードの記述

標準モジュールにAccessのテーブルをクリアするプロシージャ「wtDelete」を作成しました。

Public Sub wtDelete(ByVal strWT As String)
    Dim w_cn As New ADODB.Connection
    Set w_cn = CurrentProject.AccessConnection
    Dim w_cmd As New ADODB.Command
    w_cmd.ActiveConnection = w_cn
    w_cmd.CommandType = adCmdText
    w_cmd.CommandText = "DELETE FROM " & strWT
    w_cmd.Execute
    Set w_cmd = Nothing
End Sub

フォーム用プロシージャの記述

「Fサンプル」の読み込み時と、「新規作成」ボタンおよび「保存」ボタンのクリック時のイベントプロシージャに以下のコードを記述しました。

Private Sub Form_Load()
    Dim strSQL As String
    strSQL = "SELECT * FROM T売上伝票 IN ''[ODBC;" & strCN & "] "
    Call wtImport("WT売上伝票", strSQL)
    Me.sub伝票一覧.Requery
    If DCount("*", "WT売上伝票") = 0 Then Exit Sub
    [伝票番号] = Forms![Fサンプル].sub伝票一覧.Form![伝票番号]
    [日付] = Forms![Fサンプル].sub伝票一覧.Form![日付]
    strSQL = "SELECT * FROM T売上明細 IN ''[ODBC;" & strCN & "] WHERE 伝票番号=" & [伝票番号]
    Call wtImport("WT売上明細", strSQL)
    Me.sub売上明細.Requery
End Sub

'「新規作成」ボタンクリック時のプロシージャ----------------------------
Private Sub btnNew_Click()
    Dim n As Integer
    If GetID(n) Then
        [伝票番号] = n
    Else
        [伝票番号] = Null
    End If
    Call wtDelete("WT売上明細")
    [日付] = Null
    Me.Painting = False
    Me.sub売上明細.Requery
    Me.Painting = True
End Sub

'「保存」ボタンクリック時のプロシージャ-------------------------------------
Private Sub btnUpdate_Click()
    If IsNull([伝票番号]) Then Exit Sub
    '売上明細ゼロ件の時、売上伝票を削除する-----------------------------------
    If DCount("*", "Q売上明細") = 0 Then
        Call tDelete([伝票番号])
        [伝票番号] = Null
        [日付] = Null
        GoTo UD
    End If
    '---------------------------------------------------------------------------
    On Error GoTo Errh
    'SQLServerの一時テーブルにAccessのデータを転記する--------------------------
    Dim cn As New ADODB.Connection
    cn.Open strCN
    Dim cmd As New ADODB.Command    
    cmd.ActiveConnection = cn
    cmd.CommandType = adCmdText
    cmd.CommandText = "TRUNCATE TABLE TEMP売上明細"
    cmd.Execute
    cmd.CommandText = "TRUNCATE TABLE TEMP売上伝票"
    cmd.Execute
    
    Dim w_cn As New ADODB.Connection
    Set w_cn = CurrentProject.AccessConnection
    Dim w_cmd As New ADODB.Command
    w_cmd.ActiveConnection = w_cn
    w_cmd.CommandType = adCmdText
    w_cmd.CommandText = "INSERT INTO TEMP売上明細 SELECT * FROM WT売上明細"
    w_cmd.Execute
    
    Dim strSQL As String
    strSQL = "VALUES(" & [伝票番号]
    strSQL = strSQL & ",'" & [日付]
    strSQL = strSQL & "')"
    w_cmd.CommandType = adCmdText
    w_cmd.CommandText = "INSERT INTO TEMP売上伝票 " & strSQL
    w_cmd.Execute
   
    Set w_cmd = Nothing
    w_cn.Close: Set w_cn = Nothing
    On Error GoTo 0
    '---------------------------------------------------------------------------
    'SQLServerの一時テーブルから生データテーブルに転記する----------------------
    cmd.CommandType = adCmdStoredProc
    cmd.CommandText = "import売上情報"
    
    cmd.Parameters.Append cmd.CreateParameter(, adInteger, adParamReturnValue, , Null)
    cmd.Execute
    
    If CBool(cmd.Parameters(0).Value) Then
        GoTo UD
    Else
        MsgBox "エラーが発生しました。", vbExclamation, "確認"
        Set cmd = Nothing
        cn.Close: Set cn = Nothing
        Exit Sub
    End If
    '---------------------------------------------------------------------------
UD:
    Set cmd = Nothing
    cn.Close: Set cn = Nothing
    Me.Painting = False
    strSQL = "SELECT * FROM T売上伝票 IN ''[ODBC;" & strCN & "] "
    Call wtImport("WT売上伝票", strSQL)
    
    Me.sub伝票一覧.Requery
    If Not IsNull([伝票番号]) Then
        Me.sub伝票一覧.Form.Recordset.FindFirst "伝票番号=" & [伝票番号]
    End If
    Me.Painting = True
    If DCount("*", "WT売上伝票") <> 0 Then
        [伝票番号] = Me.sub伝票一覧.Form.[伝票番号]
        [日付] = Me.sub伝票一覧.Form.[日付]
    
        strSQL = "SELECT * FROM T売上明細 IN ''[ODBC;" & strCN & "]" _
                        & "WHERE 伝票番号=" & [伝票番号]
    
        Call wtImport("WT売上明細", strSQL)
        Me.Painting = False
        Me.sub売上明細.Requery
        Me.Painting = True
    End If
    MsgBox "保存しました。", vbInformation, "確認"
    Exit Sub
Errh:
    MsgBox "エラーが発生しました。", vbExclamation, "確認"
End Sub

サブフォーム用プロシージャの記述

「F伝票一覧」のクリック時に以下のイベントプロシージャを記述しました。

Public Sub Form_Click()
    Forms![Fサンプル].[伝票番号] = [伝票番号]
    Forms![Fサンプル].[日付] = [日付]
    Dim strSQL As String
    strSQL = "SELECT * FROM T売上明細 IN ''[ODBC;" & strCN & "] WHERE 伝票番号=" & [伝票番号]
    Call wtImport("WT売上明細", strSQL)
    Forms![Fサンプル].sub売上明細.Form.Painting = False
    Forms![Fサンプル].sub売上明細.Requery
    Forms![Fサンプル].sub売上明細.Form.Painting = True
End Sub

「F売上明細」の「削除」ボタンのクリック時に以下のイベントプロシージャを記述しました。

Private Sub btnDelete_Click()
    If Me.NewRecord Then
        MsgBox "新規レコードは削除できません。"
        Exit Sub
    End If

    [削除] = True
    Me.Requery
End Sub

アプリ作成で学ぶ Visual Basic データベースプログラミング for SQL Server 2012

【Access VBA】「あかさたな」ボタンでフォームにフィルターをかける

「あかさたな」ボタンでフォームにフィルターをかける

「あ」ボタンをクリックするとフリガナの頭文字があ行の市区町村のレコードのみ表示されます。

フォームに「あかさたな」ボタンを配置する

フォームに「あかさたな」ボタンを配置しました。名前とタグを以下のように設定しました。

コードの記述

クラスモジュールにclsFilterを作成し、下記コードを記述します。

Private WithEvents mbtn As CommandButton
Private mForm As Form
 
Public Sub Bind(ByVal oForm As Form, ByVal oCtrl As Control)
    Set mForm = oForm
    Set mbtn = oCtrl
    mbtn.OnClick = "[EVENT PROCEDURE]"
End Sub

Private Sub mbtn_Click()
    If mbtn.Tag = "全件" Then       
        mForm.FilterOn = False
    Else
        mForm.Filter = "フリガナ Like '[" & mbtn.Tag & "]*'"
        mForm.FilterOn = True
    End If
    DoCmd.GoToRecord , , acNewRec
    DoCmd.GoToControl "市区町村名"
End Sub

フォームの読み込み時イベントプロシージャに下記コードを記述します。

Private aClassFilter(10) As New clsFilter
Private Sub Form_Load()
    Dim i As Integer
   
    For i = 0 To 10
        Call aClassFilter(i).Bind(Me, Controls("btn" & i))
    Next
    
    DoCmd.GoToRecord , , acNewRec
    DoCmd.GoToControl "市区町村名"
End Sub

アプリ作成で学ぶ Access VBAプログラミング ワンランク上のフォーム&レポート

【Access VBA】SQL Serverからユニオンクエリの結果を取得する

2つのテーブルを合計した結果をグラフ表示する

SQL Serverにある２つのテーブルを合計した結果をAccessに取り込み、グラフ表示します。

SQL Serverにテーブルを準備する

SQL Serverで「sample」という名前のデータベースの中に「Tサンプル1」、「Tサンプル2」および「Tユニオンサンプル」の3つのテーブルを用意しました。ユニオンクエリの結果を「Tユニオンサンプル」に取り込みます。

Accessでフォームを準備する

下記のブログ記事でグラフを表示するフォームを作成しました。このときは「Tサンプル」テーブルをAccessに作成しましたが、今回は2つのテーブルをSQL Serverに作成し、ユニオンクエリの結果をAccessに取り込みます。。
【Access VBA】月別グラフの作成－データのない日も表示する - カットマンブログ

参照設定の準備

Visual Basic Editorを表示し、「ツール」タブの「参照設定」をクリック
　　　↓
「Microsoft ActiveX Data Objects ×.× Library」をチェック

コードの記述

標準モジュールの「SetLastDay」プロシージャを下記のコードで置き換えます。

Public Sub SetLastDay(ByVal Y As Integer, ByVal M As Integer)
'----------SQL Serverでユニオンクエリの結果を「Tユニオンサンプル」に取り込む----------
    Dim strCN As String
    Dim cn As New ADODB.Connection
    strCN = "driver={ODBC Driver 17 for SQL Server};server=LAPTOP-114315\SQLEXPRESS;DATABASE=sample;uid=administrator;PWD=1111"
    cn.Open strCN
    Dim cmd As New ADODB.Command
    cmd.ActiveConnection = cn
    cmd.CommandType = adCmdText
    cmd.CommandText = "DELETE FROM Tユニオンサンプル"
    cmd.Execute
    cmd.CommandText = "INSERT INTO Tユニオンサンプル SELECT A.日付,A.数量 FROM Tサンプル1 AS A UNION ALL SELECT B.日付,B.数量 FROM Tサンプル2 AS B"
    cmd.Execute
    Set cmd = Nothing
    cn.Close: Set cn = Nothing
'----------SQL Serverの「Tユニオンサンプル」から目的のデータを取り出す----------------
    Dim w_cn As New ADODB.Connection
    Set w_cn = CurrentProject.AccessConnection
    Dim w_cmd As New ADODB.Command
    w_cmd.ActiveConnection = w_cn
    w_cmd.CommandType = adCmdText
    w_cmd.CommandText = "DELETE FROM WTサンプル"
    w_cmd.Execute
    w_cmd.CommandText = "INSERT INTO WTサンプル SELECT A.日付, A.数量 FROM Tユニオンサンプル AS A IN ''[ODBC;" & strCN & "] WHERE Year(A.日付) =" & Y _
                        & "AND Month(A.日付) =" & M & " ORDER BY A.日付"
    w_cmd.Execute
    Set w_cmd = Nothing
'-------------------------------------------------------------------------------------
    Dim i As Integer
    Dim LastDay As Integer
    LastDay = Day(DateSerial(Y, M + 1, 1) - 1)
'----------「WTサンプル」に月初と月末の空白データを作成-----------------------------
    Dim w_strSQL As String
    w_strSQL = "SELECT * FROM WTサンプル"
    Dim w_rs As New ADODB.Recordset
    w_rs.Open w_strSQL, w_cn, adOpenKeyset, adLockOptimistic
    If w_rs.RecordCount <> 0 Then
        For i = Day(DMin("日付", "WTサンプル")) - 1 To 1 Step -1
            w_rs.AddNew
            w_rs![日付] = DateSerial(Y, M, i)
            w_rs![数量] = 0
            w_rs.Update
        Next
        For i = Day(DMax("日付", "WTサンプル")) + 1 To LastDay
            w_rs.AddNew
            w_rs![日付] = DateSerial(Y, M, i)
            w_rs![数量] = 0
            w_rs.Update
        Next
    End If
'--------------------------------------------------------------------------------------
    w_rs.Close: Set w_rs = Nothing
    w_cn.Close: Set w_cn = Nothing
End Sub

アプリ作成で学ぶ Visual Basic データベースプログラミング for SQL Server 2012

【Access VBA】主キー値をSQL Serverから取得する

主キー値をSQL Serverから取り出す

AccessをSQL Serverのテーブルに接続し、新規レコード保存の際、主キー値をSQL Serverで設定します。

SQL Serverにテーブルを準備する

SQL Serverで「sample」という名前のデータベースの中に「Tサンプル」という名前のテーブルと「T発番」という名前のテーブルを用意しました。

SQL Serverにストアドプロシージャを準備する

SQL Serverに「SetID」という名前のストアドプロシージャを用意しました。

ALTER PROCEDURE [dbo].[SetID]
	
	@ID int OUTPUT 
AS
BEGIN
	
	SET NOCOUNT ON;
    
	BEGIN TRY
		BEGIN TRANSACTION
			SELECT @ID=連番 FROM T発番 WITH(TABLOCKX)
			UPDATE T発番 SET 連番=@ID+1
		COMMIT TRANSACTION 
		RETURN-1 
	END TRY

	BEGIN CATCH
		ROLLBACK TRANSACTION		
		RETURN 0
	END CATCH
END

フォームの準備

下のようなラベル3個、テキストボックス３個、ボタン１個を配置した非連結フォームを用意しました。

コードの記述

フォームの開く時と「更新」ボタンのクリック時に下記イベントプロシージャを記述しました。

Private cn As New ADODB.Connection
Private rs As New ADODB.Recordset
Private Sub Form_Open(Cancel As Integer)
'-----------SQL Serverの「sample」データベースに接続-----------------------
    Dim strCN As String
    strCN = "driver={ODBC Driver 17 for SQL Server};server=LAPTOP-114315\SQLEXPRESS;DATABASE=sample;uid=administrator;PWD=1111"
    cn.Open strCN
'------------------------------------------------------------------------------------
'-----------ストアドプロシージャからIDを取得---------------------------------
    Dim cmd As New ADODB.Command
    cmd.ActiveConnection = cn
    cmd.CommandType = adCmdStoredProc
    cmd.CommandText = "SetID"
    cmd.Parameters.Append cmd.CreateParameter(, adInteger, adParamReturnValue, , Null)
    cmd.Parameters.Append cmd.CreateParameter("@ID", adInteger, adParamOutput, , Null)
    cmd.Execute
    
    If CBool(cmd.Parameters(0).Value) Then
        If IsNull(txtID) Then
            txtID = cmd.Parameters("@ID").Value
        End If
    Else
        MsgBox "IDの取得に失敗しました。", vbExclamation, "確認"
        cn.Close: Set cn = Nothing
        Cancel = True
    End If
'-----------------------------------------------------------------------------------
End Sub
Private Sub btnUpdate_Click()
    Dim strSQL As String
    strSQL = "SELECT * FROM Tサンプル WHERE ID=" & txtID
    rs.Open strSQL, cn, adOpenKeyset, adLockOptimistic

            rs.AddNew
            rs![ID] = txtID
            rs![日付] = txtDate
            rs![数量] = txtQuantity
            rs.Update

    rs.Close: Set rs = Nothing
    cn.Close: Set cn = Nothing
    DoCmd.Close
End Sub

テスト

現在、「ID」が「130」までのデータが保存されているとします。

フォームを開くと「ID」テキストボックスに「131」が発番されます。

日付と数量を入力し「更新」ボタンをクリックするとテーブルにレコードが保存されます。

アプリ作成で学ぶ Visual Basic データベースプログラミング for SQL Server 2012

【Access VBA】SQL ServerにADOで接続する

SQL Serverにテーブルを準備する

SQL Serverで「sample」という名前のデータベースの中に「Tサンプル」という名前のテーブルを用意しました。

Accessでフォームを準備する

下記のブログ記事でグラフを表示するフォームを作成しました。このときは「Tサンプル」テーブルをAccessに作成しましたが、今回は「Tサンプル」テーブルをSQL Serverに作成し、ADOで接続します。

【Access VBA】月別グラフの作成－データのない日も表示する - カットマンブログ

参照設定の準備

Visual Basic Editorを表示し、「ツール」タブの「参照設定」をクリック
　　　↓
「Microsoft ActiveX Data Objects ×.× Library」をチェック

コードの記述

標準モジュールの「SetLastDay」プロシージャを下記のコードで置き換えます。

Public Sub SetLastDay(ByVal Y As Integer, ByVal M As Integer)
'----------SQL Serverの「Tサンプル」から目的のデータを取り出す--------------------
    Dim w_cn As ADODB.Connection
    Set w_cn = CurrentProject.Connection
    Dim cmd As New ADODB.Command
    cmd.ActiveConnection = w_cn
    cmd.CommandType = adCmdText
    cmd.CommandText = "DELETE FROM WTサンプル"
    cmd.Execute
    Dim strCN As String
    strCN = "driver={ODBC Driver 17 for SQL Server};server=LAPTOP-114315\SQLEXPRESS;DATABASE=sample;uid=administrator;PWD=1111"
    cmd.CommandText = "INSERT INTO WTサンプル SELECT A.日付, A.数量 FROM Tサンプル AS A IN ''[ODBC;" & strCN & "] WHERE Year(A.日付) =" & Y _
                        & "AND Month(A.日付) =" & M & " ORDER BY A.日付"
    cmd.Execute
    Set cmd = Nothing
'----------------------------------------------------------------------------------
    Dim i As Integer
    Dim LastDay As Integer
    LastDay = Day(DateSerial(Y, M + 1, 1) - 1)
'----------「WTサンプル」に月初と月末の空白データを作成---------------------------
    Dim w_strSQL As String
    w_strSQL = "SELECT * FROM WTサンプル"
    Dim w_rs As New ADODB.Recordset
    w_rs.Open w_strSQL, w_cn, adOpenKeyset, adLockOptimistic
    If w_rs.RecordCount <> 0 Then
        For i = Day(DMin("日付", "WTサンプル")) - 1 To 1 Step -1
            w_rs.AddNew
            w_rs![日付] = DateSerial(Y, M, i)
            w_rs![数量] = 0
            w_rs.Update
        Next
        For i = Day(DMax("日付", "WTサンプル")) + 1 To LastDay
            w_rs.AddNew
            w_rs![日付] = DateSerial(Y, M, i)
            w_rs![数量] = 0
            w_rs.Update
        Next
    End If
'-----------------------------------------------------------------------------------
    w_rs.Close: Set w_rs = Nothing
    w_cn.Close: Set w_cn = Nothing
End Sub

グラフ表示されました。

アプリ作成で学ぶ Visual Basic データベースプログラミング for SQL Server 2012

【Access VBA】月別グラフの作成－データのない日も表示する

月別グラフの作成－データのない日も表示する

テーブルの準備

下のような2個のテーブルを用意しました。
「Tサンプル」は生データが入ったテーブルです。
「WTサンプル」はグラフに表示するデータを「Tサンプル」から取り込むためのテーブルです。

フォームの準備

下のような2個のコンボボックスと２個のラベルおよび１個のボタンを配置したフォームを作成しました。

「デザイン」タブの「グラフ」をクリックし、作成したフォームに配置します。

「グラフウィザード」が開くので「テーブル：WTサンプル」を選んで「次へ」をクリックします。

「日付」と「数量」を「選択したフィールド」に移して「次へ」をクリックします。

「縦棒グラフ」を選んで「次へ」をクリックします。

「月ごとの日付」をダブルクリックし、「グループ化の設定」で「日」を選んで「OK」をクリックし、「次へ」をクリックします。

グラフのタイトルを必要に応じて入力し、凡例の表示、非表示を選択し、「完了」をクリックします。

作成したグラフの名前は「chart」としました。

コードの記述

標準モジュールに下記コードを記述します。

Public intYear As Integer
Public intMonth As Integer
Public Sub SetLastDay(ByVal Y As Integer, ByVal M As Integer)
    DoCmd.SetWarnings False
    DoCmd.RunSQL "DELETE FROM WTサンプル"
    DoCmd.RunSQL "INSERT INTO WTサンプル SELECT 日付,数量 FROM Qサンプル"
    DoCmd.SetWarnings True
    Dim i As Integer
    Dim LastDay As Integer
    LastDay = Day(DateSerial(Y, M + 1, 1) - 1)

    Dim w_rs As Recordset
    Set w_rs = CurrentDb.OpenRecordset("WTサンプル", dbOpenDynaset)

    If w_rs.RecordCount <> 0 Then
　　For i = Day(DMin("日付", "WTサンプル")) - 1 To 1 Step -1
            w_rs.AddNew
            w_rs![日付] = DateSerial(Y, M, i)
            w_rs![数量] = 0
            w_rs.Update
        Next
        For i = Day(DMax("日付", "WTサンプル")) + 1 To LastDay
            w_rs.AddNew
            w_rs![日付] = DateSerial(Y, M, i)
            w_rs![数量] = 0
            w_rs.Update
        Next
    End If
    w_rs.Close
    Set w_rs = Nothing
End Sub

Public Function GetYear() As Integer
    GetYear = intYear
End Function

Public Function GetMonth() As Integer
    GetMonth = intMonth
End Function

Public Sub SetComboBoxYear(ByVal fm As Form, ByVal strName As String)
    Dim i As Integer
    Dim cb As ComboBox
    Set cb = fm.Controls(strName)
    For i = cb.ListCount - 1 To 0 Step -1
        cb.RemoveItem i
    Next
    For i = Year(Date) To Year(Date) - 3 Step -1
        cb.AddItem i
    Next
End Sub

Public Sub SetComboBoxMonth(ByVal fm As Form, ByVal strName As String)
    Dim i As Integer
    Dim cb As ComboBox
    Set cb = fm.Controls(strName)
    For i = cb.ListCount - 1 To 0 Step -1
        cb.RemoveItem i
    Next
    For i = 1 To 12
        cb.AddItem i
    Next
End Sub

フォームの読み込み時イベントプロシージャに下記コードを記述します。

Private Sub Form_Load()
    Call SetComboBoxYear(Me, "cboYear")
    Call SetComboBoxMonth(Me, "cboMonth")
    cboYear = Year(Date)
    cboMonth = Month(Date)
    btnUpdate_Click
End Sub

ボタンのクリック時イベントプロシージャに下記コードを記述します。

Private Sub btnUpdate_Click()
    intYear = Nz(cboYear)
    intMonth = Nz(cboMonth)
    Call SetLastDay(intYear, intMonth)
    Me.chart.Requery
End Sub

選択クエリの作成

下のような選択クエリを作成します。

グラフオプションの設定

フォームのデザインビューでグラフをダブルクリックするとグラフの編集画面が現れます。
その画面のグラフを右クリックし、「グラフのオプション」を選択します。
「軸」タブの「Ｘ／項目軸」で「時系列」を選択するとデータがない日もグラフ表示されます。「項目」を選択するとデータのない日は表示されません。

使用方法

「年」と「月」を選択して「更新」ボタンをクリックするとグラフが表示されます。

アプリ作成で学ぶ Access VBAプログラミング ワンランク上のフォーム&レポート

【Access VBA】テキストボックスに数字しか入力できないようにする

テキストボックスに数字しか入力できないようにする

標準モジュールに下記のコードを記述します。

Public Function chkNumber(ByVal KeyCode As Integer) As Integer
    Dim Flag As Boolean
    Flag = ((KeyCode >= 48) * (KeyCode <= 57)) _
            + ((KeyCode >= 96) * (KeyCode <= 105)) _
            + (KeyCode = 8) + (KeyCode = 13) + (KeyCode = 9)
    If Flag Then
        chkNumber = KeyCode
    Else
        chkNumber = 0
    End If
End Function

下記サイトを参考にしました。
VBAのTextBoxに半角数字のみ入力したい -VBAでTextBox2には半角数字の- Visual Basic（VBA） | 教えて!goo
テキストボックスのキークリック時のイベントプロシージャに下記コードを記述します。
キー入力時に記述すると「Ctrl」＋「V」が有効になってしまうので、キークリック時に記述します。

Private Sub txtSample_KeyDown(KeyCode As Integer, Shift As Integer)
    KeyCode = chkNumber(KeyCode)
End Sub

ショートカットメニューの無効化

以下の手順により右クリックメニューによる「貼り付け」を防止します。
「ファイル」タブの「オプション」をクリック
　　　↓
「Accessのオプション」ダイアログボックスを表示
　　　↓
「カレントデータベース」をクリック
　　　↓
「既定のショートカットメニュー」のチェックを外す

テキストボックスのIME入力モードの設定

テキストボックスのIME入力モードを「使用不可」に設定し、入力モードの変更ができないようにします。

アプリ作成で学ぶ Access VBAプログラミング ワンランク上のフォーム&レポート