Access VBA 代码记录
作者：互联网
Option Compare Database
Private Sub Combo4_AfterUpdate()
Dim index As String
Dim county As String
index = Me.Combo4
county = Me.Combo8
itemtype = Me.Combo10
If (county = "全部" And itemtype = "全部") Then
SQL = "SELECT * FROM 战略新兴产业项目 WHERE 申报批次 = " & index & " UNION ALL SELECT * FROM 地方基础设施项目 WHERE 申报批次 = " & index & " UNION ALL SELECT * FROM 其他社会公益、民生类项目 WHERE 申报批次 = " & index & " UNION ALL SELECT * FROM 医疗卫生补短板项目 WHERE 申报批次 = " & index & " UNION ALL SELECT * FROM 其他项目 WHERE 申报批次 = " & index
Else
If (county <> "全部" And itemtype = "全部") Then
SQL = "SELECT * FROM 战略新兴产业项目 WHERE (申报批次 = " & index & " AND 乡镇 = '" & county & "') UNION ALL SELECT * FROM 地方基础设施项目 WHERE (申报批次 = " & index & " AND 乡镇 = '" & county & "') UNION ALL SELECT * FROM 其他社会公益、民生类项目 WHERE (申报批次 = " & index & " AND 乡镇 = '" & county & "') UNION ALL SELECT * FROM 医疗卫生补短板项目 WHERE (申报批次 = " & index & " AND 乡镇 = '" & county & "') UNION ALL SELECT * FROM 其他项目 WHERE (申报批次 = " & index & " AND 乡镇 = '" & county & "')"
Else
If (county = "全部" And itemtype <> "全部") Then
SQL = "SELECT * FROM " & itemtype & " WHERE (申报批次 = " & index & ") "
Else
SQL = "SELECT * FROM " & itemtype & " WHERE (申报批次 = " & index & " AND 乡镇 = '" & county & "')"
End If
End If
End If
Dim qry As DAO.QueryDef
Set db = CurrentDb
Set qry = db.QueryDefs("申报批次")
qry.SQL = SQL
Me.申报批次_子窗体.SourceObject = "查询.查询结果"
Me.申报批次_子窗体.Form.Requery
Me.Child6.SourceObject = "查询.查询结果汇总"
Me.Child6.Form.Requery
'DoCmd.OpenForm "申报批次查询", acDesign '运行查询
End Sub
Private Sub 申报批次_子窗体_Enter()
Me.Form.Requery
End Sub
Option Compare Database
Private Sub 项目名称_Click()
Dim sql As String, itemtype As Variant, landTypes As Variant
'sql = " DELETE * FROM 地类数据 "
'CurrentDb.Execute (sql)
itemtype = Array(Array("AA", "水田"), Array("AB", "水浇地"), Array("AC", "旱地"), Array("BA", "果园"), Array("BB", "茶园"), Array("BC", "橡胶园"), Array("BD", "其他园地"), Array("CA", "乔木林地"), Array("CB", "竹林地"), Array("CC", "红树林地"), _
Array("CD", "森林沼泽"), Array("CE", "灌木林地"), Array("CF", "灌丛沼泽"), Array("CG", "其他林地"), Array("DA", "天然牧草地"), Array("DB", "人工牧草地"), Array("DC", "其他草地"), Array("EA", "零售商业用地"), Array("EB", "批发市场用地"), Array("EC", "餐饮用地"), _
Array("ED", "旅馆用地"), Array("EE", "商务金融用地"), Array("EF", "娱乐用地"), Array("EG", "其他商服用地"), Array("FA", "工业用地"), Array("FB", "采矿用地"), Array("FC", "盐田"), Array("FD", "仓储用地"), Array("GA", "城镇住宅用地"), Array("GB", "农村宅基地"), _
Array("HA", "机关团体用地"), Array("HB", "新闻出版用地"), Array("HC", "教育用地"), Array("HD", "科研用地"), Array("HE", "医疗卫生用地"), Array("HF", "社会福利用地"), Array("HG", "文化设施用地"), Array("HH", "体育用地"), Array("HI", "公用设施用地"), Array("HJ", "公园与绿地"), _
Array("IA", "军事设施用地"), Array("IB", "使领馆用地"), Array("IC", "监教场所用地"), Array("ID", "宗教用地"), Array("IE", "殡葬用地"), Array("IF", "风景名胜设施用地"), Array("JA", "铁路用地"), Array("JB", "轨道交通用地"), Array("JC", "公路用地"), Array("JD", "城镇村道路用地"), _
Array("JE", "交通服务场站用地"), Array("JF", "农村道路"), Array("JG", "机场用地"), Array("JH", "港口码头用地"), Array("JI", "管道运输用地"), Array("KA", "河流水面"), Array("KB", "湖泊水面"), Array("KC", "水库水面"), Array("KD", "坑塘水面"), Array("KE", "沿海滩涂"), _
Array("KF", "内陆滩涂"), Array("KG", "沟渠"), Array("KH", "沼泽地"), Array("KI", "水工建筑用地"), Array("KJ", "冰川及永久积雪"), Array("LA", "空闲地"), Array("LB", "设施农用地"), Array("LC", "田坎"), Array("LD", "盐碱地"), Array("LE", "沙地"), _
Array("LF", "裸土地"), Array("LG", "裸岩石砾地"))
On Error Resume Next
landTypes = Split(Me.地类, ",")
sql = "DELETE * FROM 地类数据展示"
CurrentDb.Execute (sql)
For Each j In landTypes
itype = Left(j, 2)
iarea = Val(Right(j, Len(j) - 4)) / 1000
For Each i In itemtype
If i(0) = itype Then
sql = "INSERT INTO 地类数据展示 (类别,面积) VALUES ('" & i(1) & "',FORMAT(" & iarea & ",'0.0000'))"
CurrentDb.Execute (sql)
Exit For
End If
Next
Next
Forms![项目查询]![地类数据子窗体].SourceObject = "表.地类数据展示"
Forms![项目查询]![地类数据子窗体].Requery
End Sub
Option Compare Database
Private Sub add_Click()
End Sub
Private Function arr2str(arr) As String
Dim str As String
For Each i In arr
str = str + ";" + i
Next
arr2str = Right(str, Len(str) - 1)
End Function
Private Sub cmd_additem_Click()
Dim sql As String, flag As Boolean
Dim itemtype As Variant, codestr As String, rst As DAO.Recordset
Dim n As Long
Set rst = CurrentDb.OpenRecordset("地类数据登记", dbOpenDynaset)
Set myc = New myclass
itemtype = myc.itemtype
'itemtype = Array(Array("AA", "水田", "A"), Array("AB", "水浇地", "A"), Array("AC", "旱地", "A"), Array("BA", "果园", "A"), Array("BB", "茶园", "A"), Array("BC", "橡胶园", "A"), Array("BD", "其他园地", "A"), Array("CA", "乔木林地", "A"), Array("CB", "竹林地", "A"), Array("CC", "红树林地", "A"), _
Array("CD", "森林沼泽", "A"), Array("CE", "灌木林地", "A"), Array("CF", "灌丛沼泽", "A"), Array("CG", "其他林地", "A"), Array("DA", "天然牧草地", "A"), Array("DB", "人工牧草地", "A"), Array("DC", "其他草地", "C"), Array("EA", "零售商业用地", "A"), Array("EB", "批发市场用地", "A"), Array("EC", "餐饮用地", "A"), _
Array("ED", "旅馆用地", "B"), Array("EE", "商务金融用地", "B"), Array("EF", "娱乐用地", "B"), Array("EG", "其他商服用地", "B"), Array("FA", "工业用地", "B"), Array("FB", "采矿用地", "B"), Array("FC", "盐田", "B"), Array("FD", "仓储用地", "B"), Array("GA", "城镇住宅用地", "B"), Array("GB", "农村宅基地", "B"), _
Array("HA", "机关团体用地", "B"), Array("HB", "新闻出版用地", "B"), Array("HC", "教育用地", "B"), Array("HD", "科研用地", "B"), Array("HE", "医疗卫生用地", "B"), Array("HF", "社会福利用地", "B"), Array("HG", "文化设施用地", "B"), Array("HH", "体育用地", "B"), Array("HI", "公用设施用地", "B"), Array("HJ", "公园与绿地", "B"), _
Array("IA", "军事设施用地", "B"), Array("IB", "使领馆用地", "B"), Array("IC", "监教场所用地", "B"), Array("ID", "宗教用地", "B"), Array("IE", "殡葬用地", "B"), Array("IF", "风景名胜设施用地", "B"), Array("JA", "铁路用地", "B"), Array("JB", "轨道交通用地", "B"), Array("JC", "公路用地", "B"), Array("JD", "城镇村道路用地", "B"), _
Array("JE", "交通服务场站用地", "B"), Array("JF", "农村道路", "A"), Array("JG", "机场用地", "B"), Array("JH", "港口码头用地", "B"), Array("JI", "管道运输用地", "B"), Array("KA", "河流水面", "C"), Array("KB", "湖泊水面", "C"), Array("KC", "水库水面", "A"), Array("KD", "坑塘水面", "A"), Array("KE", "沿海滩涂", "C"), _
Array("KF", "内陆滩涂", "C"), Array("KG", "沟渠", "A"), Array("KH", "沼泽地", "C"), Array("KI", "水工建筑用地", "B"), Array("KJ", "冰川及永久积雪", "C"), Array("LA", "空闲地", "B"), Array("LB", "设施农用地", "A"), Array("LC", "田坎", "A"), Array("LD", "盐碱地", "C"), Array("LE", "沙地", "C"), _
Array("LF", "裸土地", "C"), Array("LG", "裸岩石砾地", "C"))
n = rst.RecordCount
codestr = ""
flag = True
rst.MoveFirst
While Not rst.EOF
If Me.ComboChild.Value = rst.Fields("类别").Value Then
flag = False
End If
rst.MoveNext
Wend
If flag Then
sql = "INSERT INTO 地类数据登记 (类别) VALUES ('" & Me.ComboChild.Value & "')"
CurrentDb.Execute (sql)
End If
rst.Close
Set rst = Nothing
Forms![录入]![地类数据子窗体].SourceObject = "表.地类数据登记"
Forms![录入]![地类数据子窗体].Requery
End Sub
Private Sub Cmd2code_Click()
Dim itemtype As Variant, codestr As String, rst As DAO.Recordset
Dim n As Long
'sql = " DELETE * FROM 地类数据 "
Set rst = CurrentDb.OpenRecordset("地类数据登记", dbOpenDynaset)
Set myc = New myclass
itemtype = myc.itemtype
' itemtype = Array(Array("AA", "水田", "A"), Array("AB", "水浇地", "A"), Array("AC", "旱地", "A"), Array("BA", "果园", "A"), Array("BB", "茶园", "A"), Array("BC", "橡胶园", "A"), Array("BD", "其他园地", "A"), Array("CA", "乔木林地", "A"), Array("CB", "竹林地", "A"), Array("CC", "红树林地", "A"), _
Array("CD", "森林沼泽", "A"), Array("CE", "灌木林地", "A"), Array("CF", "灌丛沼泽", "A"), Array("CG", "其他林地", "A"), Array("DA", "天然牧草地", "A"), Array("DB", "人工牧草地", "A"), Array("DC", "其他草地", "C"), Array("EA", "零售商业用地", "A"), Array("EB", "批发市场用地", "A"), Array("EC", "餐饮用地", "A"), _
Array("ED", "旅馆用地", "B"), Array("EE", "商务金融用地", "B"), Array("EF", "娱乐用地", "B"), Array("EG", "其他商服用地", "B"), Array("FA", "工业用地", "B"), Array("FB", "采矿用地", "B"), Array("FC", "盐田", "B"), Array("FD", "仓储用地", "B"), Array("GA", "城镇住宅用地", "B"), Array("GB", "农村宅基地", "B"), _
Array("HA", "机关团体用地", "B"), Array("HB", "新闻出版用地", "B"), Array("HC", "教育用地", "B"), Array("HD", "科研用地", "B"), Array("HE", "医疗卫生用地", "B"), Array("HF", "社会福利用地", "B"), Array("HG", "文化设施用地", "B"), Array("HH", "体育用地", "B"), Array("HI", "公用设施用地", "B"), Array("HJ", "公园与绿地", "B"), _
Array("IA", "军事设施用地", "B"), Array("IB", "使领馆用地", "B"), Array("IC", "监教场所用地", "B"), Array("ID", "宗教用地", "B"), Array("IE", "殡葬用地", "B"), Array("IF", "风景名胜设施用地", "B"), Array("JA", "铁路用地", "B"), Array("JB", "轨道交通用地", "B"), Array("JC", "公路用地", "B"), Array("JD", "城镇村道路用地", "B"), _
Array("JE", "交通服务场站用地", "B"), Array("JF", "农村道路", "A"), Array("JG", "机场用地", "B"), Array("JH", "港口码头用地", "B"), Array("JI", "管道运输用地", "B"), Array("KA", "河流水面", "C"), Array("KB", "湖泊水面", "C"), Array("KC", "水库水面", "A"), Array("KD", "坑塘水面", "A"), Array("KE", "沿海滩涂", "C"), _
Array("KF", "内陆滩涂", "C"), Array("KG", "沟渠", "A"), Array("KH", "沼泽地", "C"), Array("KI", "水工建筑用地", "B"), Array("KJ", "冰川及永久积雪", "C"), Array("LA", "空闲地", "B"), Array("LB", "设施农用地", "A"), Array("LC", "田坎", "A"), Array("LD", "盐碱地", "C"), Array("LE", "沙地", "C"), _
Array("LF", "裸土地", "C"), Array("LG", "裸岩石砾地", "C"))
n = rst.RecordCount
codestr = ""
Dim areaNYD, areaGD, areaST, areaWLYD, areaJSYD As Double
areaNYD = 0
areaGD = 0
areaST = 0
areaWLYD = 0
areaJSYD = 0
rst.MoveFirst
While Not rst.EOF
For Each j In itemtype
If j(1) = rst.Fields("类别") And rst.Fields("面积") <> 0 Then
If j(2) = "A" Then
areaNYD = areaNYD + rst.Fields("面积")
End If
If j(0) = "AA" Or j(0) = "AB" Or j(0) = "AC" Or j(0) = "AD" Or j(0) = "AE" Or j(0) = "AF" Then
areaGD = areaGD + rst.Fields("面积")
End If
If j(0) = "AA" Then
areaST = areaST + rst.Fields("面积")
End If
If j(2) = "C" Then
areaWLYD = areaWLYD + rst.Fields("面积")
End If
If j(2) = "B" Then
areaJSYD = areaJSYD + rst.Fields("面积")
End If
If Me.belong.Value = "集体土地" Then
codestr = codestr & "," & j(0) & j(2) & "A" & rst.Fields("面积") * 10000
Else
codestr = codestr & "," & j(0) & j(2) & "B" & rst.Fields("面积") * 10000
End If
End If
Next
rst.MoveNext
Wend
Me.申报项目登记.Form.农用地.Value = areaNYD
Me.申报项目登记.Form.耕地.Value = areaGD
Me.申报项目登记.Form.水田.Value = areaST
Me.申报项目登记.Form.未利用地.Value = areaWLYD
Me.申报项目登记.Form.建设用地.Value = areaJSYD
A = Me.申报项目登记.Form.Recordset
'Forms![申报项目登记]![农用地].Value = areaNYD
'Forms![申报项目登记]![耕地].Value = areaGD
'Forms![申报项目登记]![水田].Value = areaST
'Forms![申报项目登记]![未利用地].Value = areaWLYD
'Forms![申报项目登记]![建设用地].Value = areaJSYD
'On Error Resume Next
'Forms![申报项目登记]![地类].Value = Right(codestr, Len(codestr) - 1)
Me.申报项目登记.Form.地类.Value = Right(codestr, Len(codestr) - 1)
'Forms![申报项目登记].Requery
'Me.申报项目登记.SourceObject = "申报项目登记"
'Me.申报项目登记.Form.Requery
rst.Close
Set rst = Nothing
'CurrentDb.Execute (sql)
End Sub
Private Sub CMDSET0_Click()
sql = " UPDATE 地类数据登记 SET 面积 = 0"
CurrentDb.Execute (sql)
Forms![录入]![地类数据子窗体].SourceObject = "表.地类数据登记"
Forms![录入]![地类数据子窗体].Requery
End Sub
Private Sub CombomMajor_AfterUpdate()
Dim n As Integer
Set myc = New myclass
Mjr = myc.landbigt
chd = myc.landtype
n = 0
For Each i In Mjr
If i = Me.CombomMajor.Value Then
s = arr2str(chd(n))
Me.ComboChild.RowSource = arr2str(chd(n))
End If
n = n + 1
Next
End Sub
Private Sub Form_Open(Cancel As Integer)
Dim Major As String
Major = "耕地;园地;林地;草地;商服用地;工矿仓储用地;住宅用地;公共管理与公共服务用地;特殊用地;交通运输用地;水域及水利设施用地;其他土地"
Me.CombomMajor.RowSource = Major
Me.CombomMajor.DefaultValue = "耕地"
'DoCmd.OpenForm "申报项目登记"
'Me.地类数据子窗体.SourceObject = "表.地类数据"
End Sub
Option Compare Database
Private Sub Combo4_AfterUpdate()
Dim index As String
Dim county As String
index = Me.Combo4
county = Me.Combo8
itemtype = Me.Combo10
If county = "全部" And itemtype = "全部" Then
sql = "SELECT * FROM 申报项目 where 申报批次 = " & index
Else
If county <> "全部" And itemtype = "全部" Then
sql = "SELECT * FROM 申报项目 WHERE (申报批次 = " & index & " AND 乡镇 = '" & county & "')"
Else
If county = "全部" And itemtype <> "全部" Then
sql = "SELECT * FROM 申报项目 WHERE (申报批次 = " & index & " AND 项目类型 = '" & itemtype & "')"
Else
sql = "SELECT * FROM 申报项目 WHERE (申报批次 = " & index & " AND 项目类型 = '" & itemtype & " AND 乡镇 = '" & county & "')"
End If
End If
End If
Dim qry As DAO.QueryDef
Set db = CurrentDb
Set qry = db.QueryDefs("申报项目查询")
qry.sql = sql
'Me.ChildDisplay.SourceObject = "查询.申报项目查询"
Me.ChildDisplay.SourceObject = "查询结果"
Me.ChildDisplay.Form.Requery
Me.Child6.SourceObject = "查询.统计汇总"
Me.Child6.Form.Requery
'DoCmd.OpenForm "申报批次查询", acDesign '运行查询
End Sub
Private Sub 申报批次_子窗体_Enter()
Me.Form.Requery
End Sub
标签：Me,VBA,End,用地,Access,rst,Array,代码,申报 来源： https://blog.csdn.net/codedecipher/article/details/111309695