日付が入った時のupdate
If IsNull(Me.登録日) = True Then a = "Null" Else a = "#" & Me.登録日 & "#"
'If IsNull(Me.納品書日) = True Then f = "Null" Else f = "#" & Me.納品書日 & "#"
If IsNull(Me.入金額) = True Then b = "0"
If IsNull(Me.納入単価) = True Then c = "0"
If IsNull(Me.金額) = True Then d = "0"
If IsNull(Me.数量) = True Then e = "0"
' If IsNull(Me.発注日) = True Then g = "Null" Else g = "#" & Me.発注日 & "#"
If IsNull(Me.納期) = True Then h = "Null" Else h = "#" & Me.納期 & "#"
If IsNull(Me.支払日) = True Then j = "Null" Else j = "#" & Me.支払日 & "#"
If IsNull(Me.締日) = True Then k = "Null" Else k = "#" & Me.締日 & "#"
If IsNull(Me.入金日) = True Then m = "Null" Else m = "#" & Me.入金日 & "#"
If IsNull(Me.出荷日) = True Then n = "Null" Else n = "#" & Me.出荷日 & "#"
Dim strSQL1 As String
strSQL1 = "UPDATE 受注 SET 製品図番 = '" & Me.製品図番 & "',品名 = '" & Me.品名 & "',納入単価 = '" & Me.納入単価 & "',"
strSQL1 = strSQL1 & "入金額 = '" & Me.入金額 & "',備考 = '" & Me.備考 & "',依頼伝票番号 = " & Me.依頼伝票番号 & ","
strSQL1 = strSQL1 & "出荷数 = " & Me.出荷数 & ",金額 = '" & Me.金額 & "',登録日 = " & a & ",完 = '" & Me.完 & "',出 = '" & Me.出 & "',"
strSQL1 = strSQL1 & "大分類 = '" & Me.大分類 & "',出荷日 = " & n & ",入金日 = " & m & ",締日 = " & k & ",支払日 = " & j & ",納期 = " & h & ","
strSQL1 = strSQL1 & "依頼伝票追番 = '" & Me.依頼伝票追番 & "',数量 = " & Me.数量 & ",売掛先ＣＤ = '" & Me.売掛先ＣＤ & "',売掛会社 = '" & Me.売掛会社 & "',依頼図番 = '" & Me.依頼図番 & "',"
strSQL1 = strSQL1 & "区分ＣＤ = '" & Me.区分ＣＤ & "',詳細ＣＤ = '" & Me.詳細ＣＤ & "',場所 = '" & Me.場所 & "',材料ロット = '" & Me.材料ロット & "',"
strSQL1 = strSQL1 & "内容 = '" & Me.内容 & "',表面処理 = '" & Me.表面処理 & "',材料ＣＤ = '" & Me.材料ＣＤ & "',"
strSQL1 = strSQL1 & "材料名 = '" & Me.材料名 & "',内外 = '" & Me.内外 & "',依頼元ＣＤ = '" & Me.依頼元ＣＤ & "',搬入先ＣＤ = '" & Me.搬入先ＣＤ & "' WHERE 受注番号 = '" & Me.受注番号 & "'"
cn.BeginTrans
With cmd
.CommandText = strSQL1
.CommandType = adCmdText
.Execute
End With
cn.CommitTrans
MsgBox "修正しました"
削除文の例
If IsNull(Me.行事ID) Then Exit Sub
DoCmd.RunCommand acCmdSaveRecord
Dim cn As New ADODB.Connection
Dim cmd As New ADODB.Command
Set cn = CurrentProject.Connection
Set cmd.ActiveConnection = cn
If MsgBox("削除してもよいですか", vbYesNo) = vbNo Then
DoCmd.Close
Else
' CN.BeginTrans
With cmd
.CommandText = "DELETE * FROM 行事Ｍ WHERE 行事ID = " & Me.行事ID & ""
.CommandType = adCmdText
.Execute
End With
' CN.CommitTrans
MsgBox "削除しました"
End If
西暦、和暦変換テーブルを用いた、西暦より和暦に変換するコードの一部
rs.CursorLocation = adUseServer
rs.CursorType = adOpenStatic
rs.LockType = adLockOptimistic
rs.Open "SELECT * from 追善一時 ", cn, , , adCmdText
If rs.EOF Then Exit Sub
rs.MoveFirst
Do Until rs.EOF
bb = rs.Fields("仮設定日")
Set rs6 = New ADODB.Recordset
rs6.Open "SELECT * from 元号 order by 始年月日", cn, , , adCmdText
If rs6.EOF = True Then
End If
rs6.MoveFirst
Do Until rs6.EOF
D = rs6.Fields("始年月日")
c = rs6.Fields("元号")
rs6.MoveNext
If rs6.EOF Then
y = c
Exit Do
End If
dd = rs6.Fields("始年月日")
cc = rs6.Fields("元号")
If bb >= D And bb < dd Then
y = c
Exit Do
End If
Loop
x = Year(bb) - Year(D) + 1
If x = "1" Then x = "元"
r = y & x
S = Format(bb, "mm")
t = r & "年" & S & "月"
A = Format(bb, "yyyy" & "/" & "mm")
ADOXによるテーブル作成
Dim a
Dim z
Dim y
Dim x
Dim zzz
Dim k
Dim b
Dim e
a = "A"
y = CDate(Me.月1)
zzz = DateAdd("m", 1, y)
Dim CAT As ADOX.Catalog
Dim TB As ADOX.Table
Set CAT = New ADOX.Catalog
CAT.ActiveConnection = CurrentProject.Connection
'テーブルを作成
Set TB = New ADOX.Table
TB.Name = "予定"
Do Until y = zzz
'フィールド定義
b = "1"
For k = 1 To 5
x = a & b
z = y & x
TB.Columns.Append z, adVarWChar, 10
' TB.Columns.Append "氏前", adVarWChar, 30
c = Val(b)
c = c + 1
b = Str(c)
a = "A"
Next k
y = DateAdd("d", 1, y)
Loop
Dim cn As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim rs As ADODB.Recordset
Dim ss
Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
Set cmd.ActiveConnection = cn
rs.CursorType = adOpenStatic
rs.LockType = adLockOptimistic
rs.Open "SELECT * from 予約日", cn, , , adCmdText
If Not rs.EOF = True Then
rs.MoveFirst
Do Until rs.EOF
ss = rs.Fields("名前")
TB.Columns.Append ss, adVarWChar, 20
rs.MoveNext
Loop
Else
End If
'データベースに登録
CAT.Tables.Append TB
Set CAT = Nothing
Application.RefreshDatabaseWindow 'データベースを表示
EXCEL出力の例
Dim myXLS As Excel.Application
Dim myWKB As Excel.Workbook
Dim myWKS As Excel.Worksheet
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim rs2 As New ADODB.Recordset
Dim rs3 As New ADODB.Recordset
Set conn = CurrentProject.Connection
Dim cmd As New ADODB.Command
Set cmd.ActiveConnection = conn
rs.Open "SELECT * FROM 入金 INNER JOIN 仕訳項目 ON (入金.小分類 = 仕訳項目.小分類) AND (入金.中分類 = 仕訳項目.中分類) AND (入金.大分類 = 仕訳項目.大分類) WHERE 入金日 Between #" & Me.開始日 & "# And #" & Me.終了日 & "# AND 入金.計 = '" & 1 & "' ORDER BY 入金.大分類, 仕訳項目.CD", conn, , , adCmdText
If rs.EOF Then Exit Sub
Set myXLS = New Excel.Application
myXLS.Visible = True '--------------------------Workbookを開く
Set myWKB = myXLS.Workbooks.Add
Set myWKS = myWKB.Worksheets("sheet1")
Dim g As Long
myXLS.Cells(2, 2).Value = "期間 " & FormatDateTime(Me.開始日.Value) & "〜" & FormatDateTime(Me.終了日.Value)
myXLS.Cells(4, 2).Value = "中分類"
myXLS.Cells(4, 3).Value = "小分類"
myXLS.Cells(4, 4).Value = "摘要"
myXLS.Cells(4, 5).Value = "金額"
myXLS.Cells(4, 6).Value = "入金日"
myXLS.Cells(4, 7).Value = "対象"
myXLS.Cells(4, 8).Value = "備考"
g = 4
rs.MoveFirst
Do Until rs.EOF
g = g + 1
myXLS.Cells(g, 2).Value = rs.Fields(2) ' ------テーブルの項目は0 よりカウントする
myXLS.Cells(g, 3).Value = rs.Fields(3)
myXLS.Cells(g, 4).Value = rs.Fields(4)
myXLS.Cells(g, 5).Value = rs.Fields(8)
myXLS.Cells(g, 6).Value = FormatDateTime(rs.Fields(9))
myXLS.Cells(g, 7).Value = rs.Fields(12)
myXLS.Cells(g, 8).Value = rs.Fields(11)
rs.MoveNext
Loop
SQL文で抽出したデータをいきなりデータの更新は不可能で主キーをWHEREにあてがう
rs.Open "SELECT * from 入金元帳 WHERE 手形番号 = '" & Me.手形番号 & "'", conn, , , adCmdText
rs.MoveFirst
Do Until rs.EOF
x = rs.Fields("ＣＤ").Value
With cmd
.CommandText = "UPDATE 入金元帳 SET 手形決済金額 = '" & Me.決済金額 & "',手形補正 = '" & Me.補正 & "',手形補正内容 = '" & Me.補正内訳 & "',手形完 = '" & 2 & "' WHERE ＣＤ = " & x & ""
.CommandType = adCmdText
.Execute
End With
rs.MoveNext
Loop
ADPで、別フオームのサブフオームのRequeryする場合
Set Forms!入力!入力子.Form.Recordset = rs
Forms!入力.入力子.Requery
条件付きで、例えば、現品カードなどを同一紙に複数印刷する場合の例
レポートにプロシジャーをセットする
Option Explicit
Dim P_COUNT As Long, SUURYO As Double
Private Sub Report_NoData(Cancel As Integer)
Cancel = True
End Sub
Private Sub Report_Open(Cancel As Integer)
P_COUNT = 1: SUURYO = 0
End Sub
Private Sub 詳細_Format(Cancel As Integer, FormatCount As Integer)
If P_COUNT < Me!枚数 Then
Me.MoveLayout = True
Me.NextRecord = False
Me.PrintSection = True
End If
End Sub
Private Sub 詳細_Print(Cancel As Integer, PrintCount As Integer)
On Error GoTo ERR
Me!枚数S = P_COUNT
If P_COUNT = 1 Then SUURYO = Me!数量
If P_COUNT < Me!枚数 Then
Me!SNP1 = Me!SNP
SUURYO = SUURYO - Me!SNP
P_COUNT = P_COUNT + 1
Else
Me!SNP1 = SUURYO
SUURYO = 0
P_COUNT = 1
End If
Exit Sub
ERR:
MsgBox ERR.Description
Exit Sub
On Error GoTo 0
End Sub
配列の例
Dim rec(99)
' 100項目データがセットできる
Set cur2 = CurrentDb
Set soc2 = cur2.OpenRecordset("SELECT * FROM 仮 Where 伝票番号 <> Null Order By 伝票番号 Asc;", dbOpenDynaset)
If soc2.EOF Then Exit Function ' 5月12日追加
soc2.MoveFirst
Do Until soc2.EOF
b = soc2.Fields("伝票番号").Value
Set con = New ADODB.Connection
con.ConnectionString = "Provider=SQLOLEDB;Data Source=SERVERWCC;Initial Catalog=kansc;User ID=O3791;Password=P#m8i4;Integrated Security = SSPI;"
Set rst = New ADODB.Recordset
'If Not soc2.EOF Then
con.Open
Set cmd.ActiveConnection = con
con.BeginTrans
rst.Open "Select 伝票番号 From 受注オーダ Where 伝票番号 = '" & b & "';", con, adOpenKeyset, adLockOptimistic
'rs2.CursorLocation = adUseServer
'rs2.CursorType = adOpenStatic
' rs2.LockType = adLockOptimistic
' con.BeginTrans
' c = rst.Fields("伝票番号").Value
rec(0) = soc2.Fields("伝票番号").Value
rec(1) = soc2.Fields("先").Value
rec(2) = soc2.Fields("区分").Value
rec(3) = soc2.Fields("代行先").Value
rec(4) = soc2.Fields("店舗コード").Value
rec(5) = soc2.Fields("店舗担当").Value
' 途中は省略
rec(97) = soc2.Fields("CL工料込").Value
rec(98) = soc2.Fields("CL出張代込").Value
rec(99) = soc2.Fields("CL合計込").Value
ホルダー指定で、フアイルを検索する場合
標準プロシジャーに設定
Option Compare Database
Type BROWSEINFO
hWndOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Declare Function SHBrowseForFolder Lib "SHELL32" (lpbi As BROWSEINFO) As Long
Declare Function SHGetPathFromIDList Lib "SHELL32" (ByVal pIDL As Long, ByVal pszPath As String) As Long
Public Function GetBrowseFolder(strMsg As String) As String
'フォルダ参照ダイアログを表示し選択されたフォルダ名を返します。
'引数 strMsg : ダイアログに表示するメッセージ(例:"フォルダを指定して下さい")
'[キャンセル]ボタンやESCキーが押された場合は長さゼロ("")の文字列を返します。
Dim udtBrowseInfo As BROWSEINFO
Const cMaxPathLen = 256
Dim strBuffer As String * cMaxPathLen
Dim strPathBuffer As String * cMaxPathLen
Dim strRetPath As String
Dim lngRet As Long
'BROWSEINFO構造体を定義します
With udtBrowseInfo
.hWndOwner = Application.hWndAccessApp
.pidlRoot = 0
.pszDisplayName = strBuffer
.lpszTitle = strMsg & vbNullChar
.ulFlags = 1
.lpfn = 0
.lParam = 0
.iImage = 0
End With
GetBrowseFolder = "" '返り値の初期設定を行います
lngRet = SHBrowseForFolder(udtBrowseInfo) 'フォルダ参照ダイアログを表示します
If lngRet <> 0 Then 'API関数の返り値をチェックします
If SHGetPathFromIDList(lngRet, strPathBuffer) <> 0 Then
'返り値にフォルダ名をセットします
GetBrowseFolder = Left(strPathBuffer, InStr(strPathBuffer, vbNullChar) - 1)
End If
End If
End Function
MDBとの接続時、データソースをテーブル名より指定する場合
Dim z As String
'*********
Dim rs5 As New ADODB.Recordset
Dim rs6 As New ADODB.Recordset
Dim rsx As New ADODB.Recordset
Dim cmd As New ADODB.Command
Dim con2 As New ADODB.Connection
Set con2 = CurrentProject.Connection
Set cmd.ActiveConnection = con2
Set rsx = New ADODB.Recordset
rsx.Open "SELECT * from 対象 ", con2, , , adCmdText
z = rsx.Fields("対象")
'*********
conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & z
conn.Open
MDBとの接続時、データソースをテーブル名より指定する場合
Dim z As String
'*********
Dim rs5 As New ADODB.Recordset
Dim rs6 As New ADODB.Recordset
Dim rsx As New ADODB.Recordset
Dim cmd As New ADODB.Command
Dim con2 As New ADODB.Connection
Set con2 = CurrentProject.Connection
Set cmd.ActiveConnection = con2
Set rsx = New ADODB.Recordset
rsx.Open "SELECT * from 対象 ", con2, , , adCmdText
z = rsx.Fields("対象")
'*********
conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & z
conn.Open
サブフオームのデータ取得
Dim aa As Currency
aa = Me.詳細入金子.Controls("小計")
insert into 文の例
With cmd
.CommandText = "insert into 仮オーダ(注文番号,店舗コード,お客様,型番,出荷日,ネバ番号) VALUES( '" & aa & "','" & ab & "','" & ac & "','" & ad & "','" & aj & "','" & ak & "')"
.CommandType = adCmdText
.Execute
End With
ADOXによるフイルード追加
Dim cat As ADOX.Catalog
Dim tbl As ADOX.Table
Dim col As ADOX.Column
Set cat = New ADOX.Catalog
cat.ActiveConnection = CurrentProject.Connection
Set tbl = cat.Tables(Item:="テーブル名")
Set col = New ADOX.Column
With col
.ParentCatalog = cat
.Name = "新規フィールド名"
.Type = adInteger
.Properties("AutoIncrement") = True
End With
tbl.Columns.Append Item:=col
Set cat = Nothing
Set tbl = Nothing
Set col = Nothing
印刷時の方法
DoCmd.OpenReport "作業者一覧表", acPreview
If MsgBox("印刷してもよいですか", vbYesNo) = vbNo Then
DoCmd.Close
Else
On Error Resume Next
DoCmd.RunCommand acCmdPrint
DoCmd.Close
End If
do loop 内でｒｓを使用時はrs.open の直前にset rs をする
rs3.Open "SELECT * from 組合登録一時 where 選択 = true", cn, , , adCmdText
If Not rs3.EOF Then
rs3.MoveFirst
Do Until rs3.EOF
Set rs21 = New ADODB.Recordset
rs21.Open "SELECT * from 人員登録発行 where ID = " & rs3.Fields("ID") & "", cn, , , adCmdText
If Not rs21.EOF Then
With cmd
.CommandText = "UPDATE 人員登録発行 SET 選択 = " & rs3.Fields("選択") & ",更新日 = #" & Date & "# WHERE CD = " & rs21.Fields("CD") & ""
.CommandType = adCmdText
.Execute
End With
rs3.MoveNext
Else
End If
Loop
Else
End If
BeginTransとCommitTransの例
CN.BeginTrans
With cmd
.CommandText = "DELETE * FROM 科目Ｍ WHERE 科目CD = '" & Me.科目CD & "'"
.CommandType = adCmdText
.Execute
End With
CN.CommitTrans
テキストデータのインポート例
Dim cur As Database
Dim soc As Recordset
Err.Clear
On Error GoTo 0
DoCmd.TransferText acImportDelim, , "仮", Me.取込.Value, True
Err.Clear
On Error Resume Next
Set cur = CurrentDb
Set soc = cur.OpenRecordset("SELECT COUNT(*) FROM " & Me.取込 & "_インポート エラー ;", dbOpenDynaset)
If Err.Number = 0 Then
If soc.Fields(0).Value > 0 Then MsgBox "解釈できないレコードがあります。"
End If
soc.Close
Set soc = Nothing
Set cur = Nothing
On Error GoTo 0
登録時のチエック例
a = Me.CD
b = Len(a)
If b <> 5 Then Exit Sub
rs4.Open "SELECT * from 仕訳項目 WHERE CD = '" & a & "'", cn, , , adCmdText
If Not rs4.EOF Then
If rs4.Fields("CD").Value = a Then
MsgBox "コードが登録済みです。"
Exit Sub
End If
End If
rs2.Open "SELECT * from 仕訳項目 WHERE 大分類 = '" & Me.大分類 & "' and 中分類 = '" & Me.中分類 & "' and 小分類 = '" & Me.小分類 & "'", cn, , , adCmdText
If Not rs2.EOF Then
If rs2.Fields("大分類").Value = Me.大分類 And rs2.Fields("中分類").Value = Me.中分類 And rs2.Fields("小分類").Value = Me.小分類 Then
MsgBox "登録済みです。"
Exit Sub
End If
Else
rs.Open "仕訳項目", cn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
rs.AddNew
rs("大分類") = Me.大分類
rs("中分類") = Me.中分類
rs("更新日") = Date
rs("小分類") = Me![小分類]
rs("備考") = Me![備考]
rs("計") = "1"
' rs("計") = Me![計]
rs("CD") = Me![CD]
rs.Update
End If
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
日付の設定
当月初日
DateSerial(Year(Forms![フォーム名]![年月日]),Month(Forms![フォーム名]![年月日]),1)
当月月末
DateSerial(Year(Forms![フォーム名]![年月日]),Month(Forms![フォーム名]![年月日])+1,0)
ですね。
（当月の月末日） DateSerial(Year(Date()),Month(Date())+1,0)
（翌月の２０日） DateSerial(Year(Date()),Month(Date())+1,20)
（翌々月１日） DateSerial(Year(Date()),Month(Date())+2,1)
（翌日から数えて30日後） DateSerial(Year(Date()),Month(Date()),Day(Date())+30)
データのラストデータを検出して対象のデータを削除
rs6.Open "SELECT last(番号) as ed from 宛先表", cnn, adOpenKeyset, adLockOptimistic
If rs6.EOF Then Exit Sub
a = Nz(rs6.Fields("ed"), 0)
cnn.Execute "DELETE FROM 宛先表 where 番号 = " & a & ""
日付をテキスト形式でテーブルに格納する場合
例えば
H21/08/28のような形式で
b = Date
bb = Format(b, "gee/mm/dd")------- bb が H21/08/28
通常の形式にもどす場合
cc = Format(bb, "yyyy/mm/dd")-------ccが 2009/08/28
日付をテキスト形式でテーブルで保存すると 更新などはやりやすいが
日付計算はしにくい
If Day(cc) > 20 Then
yy = DateSerial(Year(cc), Month(cc) - CInt(20 = 0) + 1, 20)
Else
yy = DateSerial(Year(cc), Month(cc) - CInt(20 = 0) + 0, 20)
クエリーで、データベースのアクションをする場合
DoCmd.SetWarnings False
'バックアップデータ削除
DoCmd.RunSQL "DELETE * FROM BTD_日報番号データ"
DoCmd.RunSQL "DELETE * FROM BTD_入金ヘッダー"
DoCmd.RunSQL "DELETE * FROM BTD_入金明細"
エラー発生後のスルー
On Error Resume Next
WHERE にＳＥＬＥＣＴ文で抽出したものを使用
With cmd
.CommandText = "update 受注オーダ set 印済 = '" & a & "',出荷日 = #" & b & "# where 伝票番号 in (select 伝票番号 from 印刷対象)"
.CommandType = adCmdText
.Execute
End With
この場合、伝票番号は実際のデータと合っていること
ＮＺ関数とＩＩＦ関数
A = Nz(Me.詳細子.Form.小計.Value, 0)
A = IIf(IsNull(Me.詳細子.Form.小計.Value), 0, Me.詳細子.Form.小計.Value)
金額及び数字のＮＵＬＬ対策
Dim a As Currency
Me.入金明細子.Form.入金小計.SetFocus
On Error Resume Next
a = Nz(Me.入金明細子.Form.入金小計.Value, 0)
入金額 = a
SQL文を複数行で作成し、実行時
Dim strSQL1 As String
strSQL1 = "UPDATE 実績表 SET 工事 = '" & Me.工事 & "',名称 = '" & Me.名称 & "',単価 = '" & Me.単価 & "',"
strSQL1 = strSQL1 & "単位 = '" & Me.単位 & "',数量 = " & Me.数量 & ",小計 = '" & Me.小計 & "',"
strSQL1 = strSQL1 & "備考 = '" & Me.備考 & "'"
strSQL1 = strSQL1 & " WHERE 請求番号 = '" & Me.請求番号 & "' and 追番 = " & Me.追番 & ""
With cmd
.CommandText = strSQL1
.CommandType = adCmdText
.Execute
End With
SELECT文で抽出したデータをINSERT文で登録する
With cmd
.CommandText = "INSERT INTO PC修理管理表 (伝票番号,お客様名,メーカ名,商品名,型番,SN,障害内容,バーコード,登録日,発行者,家電かPCか,登録番号1,登録番号2) (SELECT 伝票番号,お客様名,メーカ名,商品名,型番,SN,コメント,バーコード,'" & b & "','" & c & "'," & d & ",'" & Format(e, "00000000") & "','" & Format(f, "0000") & "' from 修理管理表 WHERE 伝票番号 = '" & a & "')"
.CommandType = adCmdText
.Execute
End With
ホルダー検索用のプロシジャー
Dim 保存先 As String
Me.先新 = GetBrowseFolder("保存先")
MDBと接続方法
Dim con As New ADODB.Connection
Set con = New ADODB.Connection
con.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=\\Serveraa\部品管理\部材管理DB.mdb"
入力を指定する方法の例
Ｉf Me.科目上 = "収益" Then
Me.買掛Ｒ.Visible = False
Me.買掛先CD.Visible = False
Me.買掛先名.Visible = False
Me.売掛Ｒ.Visible = True
Me.売掛先ＣＤ.Visible = True
Me.売掛先名.Visible = True
Else
Me.売掛Ｒ.Visible = False
Me.売掛先ＣＤ.Visible = False
Me.売掛先名.Visible = False
Me.買掛Ｒ.Visible = True
Me.買掛先CD.Visible = True
Me.買掛先名.Visible = True
End If
サブフォーム のデータを Requeryする場合
rs.Open "SELECT * from 図番Ｍ where 製品ＣＤ like '" & Me.検索 & "%" & "'", cn, , , adCmdText
If rs.EOF = True Then Exit Sub
Me.図番子.[製品ＣＤ].ControlSource = "製品ＣＤ"
Me.図番子.[製品図番].ControlSource = "製品図番"
Me.図番子.[品名].ControlSource = "品名"
Set Recordset = rs
Me.図番子.Requery