ICode9
精准搜索请尝试： 精确搜索
首页
编程语言>
数据库
系统相关
互联网
其他分享
Python
Java
JavaScript
android
PHP
首页 > 其他分享> 文章详细

Access VBA 代码记录

2020-12-17 10:29:08  阅读：182  来源： 互联网

标签：Me VBA End 用地 Access rst Array 代码 申报 


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

本站声明： 1. iCode9 技术分享网（下文简称本站）提供的所有内容，仅供技术学习、探讨和分享；
2. 关于本站的所有留言、评论、转载及引用，纯属内容发起人的个人观点，与本站观点和立场无关；
3. 关于本站的所有言论和文字，纯属内容发起人的个人观点，与本站观点和立场无关；
4. 本站文章均是网友提供，不完全保证技术分享内容的完整性、准确性、时效性、风险性和版权归属；如您发现该文章侵犯了您的权益，可联系我们第一时间进行删除；
5. 本站为非盈利性的个人网站，所有内容不会用来进行牟利，也不会利用任何形式的广告来间接获益，纯粹是为了广大技术爱好者提供技术内容和技术思想的分享性交流网站。

关于我们 | 联系我们 | 留言反馈

专注分享技术，共同学习，共同进步。侵权联系[81616952@qq.com]

Copyright (C)ICode9.com, All Rights Reserved.

ICode9版权所有