frmintegraevaluate.frm

用于河南省主体功能区区划的一个小地理信息系统

VERSION 5.00
Begin VB.Form frmintegraEvaluate 
   Caption         =   "划分主体功能区综合评价"
   ClientHeight    =   5070
   ClientLeft      =   60
   ClientTop       =   465
   ClientWidth     =   5475
   LinkTopic       =   "Form1"
   ScaleHeight     =   5070
   ScaleWidth      =   5475
   StartUpPosition =   3  '窗口缺省
   Begin VB.Frame Frame2 
      Caption         =   "综合评价专题图"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2055
      Left            =   120
      TabIndex        =   5
      Top             =   3000
      Width           =   5295
      Begin VB.CommandButton Command4 
         Caption         =   "综合评价专题图"
         Height          =   615
         Left            =   600
         TabIndex        =   6
         Top             =   1320
         Width           =   2415
      End
      Begin VB.Label Label2 
         BackColor       =   &H8000000B&
         BorderStyle     =   1  'Fixed Single
         Caption         =   "根据计算的综合评价结果，进行分级渲染，不同的功能区以不同的颜色直观显示。"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   855
         Left            =   120
         TabIndex        =   7
         Top             =   360
         Width           =   5055
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "综合评价计算"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   15
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2655
      Left            =   120
      TabIndex        =   0
      Top             =   240
      Width           =   5415
      Begin VB.CommandButton Command3 
         Caption         =   "将结果输出到区划数据库"
         Height          =   615
         Left            =   3000
         TabIndex        =   4
         Top             =   1800
         Width           =   2295
      End
      Begin VB.CommandButton Command2 
         Caption         =   "关闭EXCEL"
         Height          =   615
         Left            =   1560
         TabIndex        =   3
         Top             =   1800
         Width           =   1335
      End
      Begin VB.CommandButton Command1 
         Caption         =   "打开EXCEL"
         Height          =   615
         Left            =   120
         TabIndex        =   1
         Top             =   1800
         Width           =   1335
      End
      Begin VB.Label Label1 
         BackColor       =   &H8000000B&
         BorderStyle     =   1  'Fixed Single
         Caption         =   "集成EXCEL强大的数据处理功能，计算结果输出到区划数据库。"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   1215
         Left            =   120
         TabIndex        =   2
         Top             =   360
         Width           =   4935
      End
   End
End
Attribute VB_Name = "frmintegraEvaluate"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Dim xlApp As excel.Application '定义EXCEL类
Dim xlBook As excel.Workbook '定义工件簿类
Dim xlsheet As excel.Worksheet '定义工作表类

Private Sub Command1_Click()
  If Dir("D:\temp\excel.bz") = "" Then '判断EXCEL是否打开
    Set xlApp = CreateObject("Excel.Application") '创建EXCEL应用类
    xlApp.Visible = True '设置EXCEL可见
    Set xlBook = xlApp.Workbooks.Open(App.path + "\" + "综合评价计算表.xls") '打开EXCEL工作簿
    Set xlsheet = xlBook.Worksheets(1) '打开EXCEL工作表
    xlsheet.Activate '激活工作表
    xlsheet.Cells(1, 1) = "abc" '给单元格1行驶列赋值
    xlBook.RunAutoMacros (xlAutoOpen) '运行EXCEL中的启动宏
  Else
    MsgBox ("EXCEL已打开")
  End If
End Sub



Private Sub Command2_Click()
  If Dir("D:\temp\excel.bz") <> "" Then '由VB关闭EXCEL
    xlBook.RunAutoMacros (xlAutoClose) '执行EXCEL关闭宏
    xlBook.Close (True) '关闭EXCEL工作簿
    xlApp.Quit '关闭EXCEL
  End If
  Set xlApp = Nothing '释放EXCEL对象
 

End Sub

Private Sub Command3_Click()
Set tempxlWorkbook = tempxlApp.Workbooks.Open(strPicName)
          tempxlApp.DisplayAlerts = False
          Set tempxlSheet = tempxlWorkbook.Worksheets(strSheet)
          tempxlSheet.Select
            

End Sub

Private Sub Command4_Click()
  If Command4.Value = True Then
        Command4.Value = False
 'Dim dc As New MapObjects2.DataConnection
  '      dc.Database = App.path + "\" + "分析数据"
'        If Not dc.Connect Then End
   '     Set layer = New MapLayer
    '    Set layer.GeoDataset = dc.FindGeoDataset("综合评价")
     '   layer.Symbol.style = moTransparentFill
      '  layer.Symbol.OutlineColor = moBlue
       ' Map1.Layers.Add layer
     '   legend1.setMapSource Map1
      ''  legend1.LoadLegend True
        
        Dim tbl As New MapObjects2.Table
        tbl.Database = "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source= " & App.path & "\区划数据.mdb;"
        tbl.Name = "指标合并"
        frmmain.Map1.Layers("河南县界").RemoveRelates
        frmmain.Map1.Layers("河南县界").AddRelate "CNTY_CODE", tbl, "CNTY_CODE", True

          
        Set frmmain.g_activelayer = frmmain.Map1.Layers("河南县界")
        frmLayerSymbol.sstLayerProp.Tab = 2
        frmLayerSymbol.Show vbModal
    Else
'        Dim Index As Long
        Dim i As Integer
        For i = 0 To frmmain.Map1.Layers.Count - 1
             If frmmain.Map1.Layers(i).Name = "河南县界" Then
                 Index = i
                 Exit For
            End If
        Next i
        frmmain.Map1.Layers(Index).RemoveRelates
        frmmain.Map1.Layers.Remove Index
        frmmain.TuLi.setMapSource frmmain.Map1
        frmmain.TuLi.LoadLegend True
        Command4.Value = True
    End If
End Sub