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 乡镇 =
Else
If ( county = "全部" And itemtype <> " 全部") Then
SQL = "SELECT * FROM " & itemtype & " WHERE ( 申报批次 = " & index & " ) "
Else
SQL = "SELECT * FROM " & itemtype & " WHERE ( 申报批次 = " & index & " AND 乡镇 =
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
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
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 (
CurrentDb.Execute ( sql)
Exit For
End If
Next
Next
Forms
Forms
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
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 (
CurrentDb.Execute ( sql)
End If
rst.Close
Set rst = Nothing
Forms
Forms
End Sub
Private Sub Cmd2code_Click( )
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
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
Me .申报项目登记.Form.地类.Value = Right ( codestr, Len ( codestr) - 1 )
rst.Close
Set rst = Nothing
End Sub
Private Sub CMDSET0_Click( )
sql = " UPDATE 地类数据登记 SET 面积 = 0 "
CurrentDb.Execute ( sql)
Forms
Forms
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 = "耕地"
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 乡镇 =
Else
If county = "全部" And itemtype <> " 全部" Then
sql = "SELECT * FROM 申报项目 WHERE ( 申报批次 = " & index & " AND 项目类型 =
Else
sql = "SELECT * FROM 申报项目 WHERE ( 申报批次 = " & index & " AND 项目类型 =
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.Form.Requery
Me .Child6.SourceObject = "查询.统计汇总"
Me .Child6.Form.Requery
End Sub
Private Sub 申报批次_子窗体_Enter( )
Me .Form.Requery
End Sub
激活子窗体,并加载指定记录集
Forms
DoCmd.GoToRecord acActiveDataObject, , acGoTo, ( rs.AbsolutePosition + 1 )