⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmwopcl_p.frm

📁 对ACCESS数据库的数据根据用户的选择做简单分类
💻 FRM
📖 第 1 页 / 共 2 页
字号:
     Set rsMS = db.OpenRecordset(stSQL)
      
'PRINT
     Do Until rsMS.EOF
     
     Sel.Paragraphs.Alignment = wdAlignParagraphCenter '本单元排列居中
     Sel.Font.Name = "仿宋_GB2312"
     Sel.Font.Size = 20
     Sel.Font.Bold = True
     Sel.TypeText Text:="江苏省农作物遥感监测报告"
     
      '定义表头
     Sel.Font.Size = 15
     Sel.TypeText Text:=Chr(10)
     Sel.TypeText Text:=Chr(10)
     Sel.Font.Bold = False
     Sel.Paragraphs.Alignment = wdAlignParagraphLeft '本单元排列居左
     Sel.Font.Name = "楷体_GB2312"
     
     Sel.TypeText Text:="报告日期:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=rsMS!WLM_AD
     
     Sel.TypeText Text:=Space(10)
     Sel.TypeText Text:="影象轨道:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=rsMS!WLM_ION
     Sel.TypeText Text:=Chr(10)
     
     Sel.TypeText Text:="市:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=rsMS!WLM_LC
     Sel.TypeText Text:=Space(5)
     Sel.TypeText Text:="县:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=rsMS!WLM_SC
     Sel.TypeText Text:=Chr(10)
     
     Sel.TypeText Text:="调查数据(万亩/公顷):麦:" ' "油菜:" & Space(10) & " 蔬菜:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=rsMS!WLM_WGDM & "/" & rsMS!WLM_WGDH
     Sel.TypeText Text:=Space(2) & "油菜:" '& Space(10) & " 蔬菜:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=rsMS!WLM_OGDM & "/" & rsMS!WLM_OGDH
     Sel.TypeText Text:=Space(2) & " 蔬菜:"
     Sel.TypeText Text:=rsMS!WLM_VGDM & "/" & rsMS!WLM_VGDH
     Sel.TypeText Text:=Chr(10)
     
     Sel.TypeText Text:="分类类型:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=rsMS!WLM_CLT
     Sel.TypeText Text:=Chr(10)
     
     Sel.TypeText Text:="分类号:" '& Space(20) & "文件位置:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=rsMS!WLM_CLTN
     Sel.TypeText Text:=Space(5) & "文件位置:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=rsMS!WLM_FP
     Sel.TypeText Text:=Chr(10)
     
     Sel.TypeText Text:="非监督分类数:" ' & Space(20) & "SIG文件名:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=rsMS!WLM_USCN
     Sel.TypeText Text:=Space(5) & "SIG文件名:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=rsMS!WLM_USIG
     Sel.TypeText Text:=Chr(10)
     
     Sel.TypeText Text:="监督分类数:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=rsMS!WLM_SCN
     Sel.TypeText Text:=Space(5) & "SIG文件名:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=rsMS!WLM_SSIG
     Sel.TypeText Text:=Chr(10)
     
     Sel.TypeText Text:="含非监督类:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=rsMS!WLM_SCUN
     Sel.TypeText Text:=Chr(10)
     
     Sel.TypeText Text:="非矢量面积:" '& Space(20) & "矢量面积:" & Space(20) & "误差:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=rsMS!WLM_UUVA
     Sel.TypeText Text:=Space(5) & "矢量面积:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=rsMS!WLM_SVA
     Sel.TypeText Text:=Space(5) & "误差:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=rsMS!WLM_SVAE
     Sel.TypeText Text:=Chr(10)
     
     Sel.TypeText Text:="聚类文件名:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=rsMS!WLM_CFM
     Sel.TypeText Text:=Space(5) & "矢量面积:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=rsMS!WLM_CFVA
     Sel.TypeText Text:=Space(5) & "误差:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=rsMS!WLM_CFVAE
     Sel.TypeText Text:=Chr(10)
     
     Sel.TypeText Text:="过滤文件名:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=rsMS!WLM_SFN
     Sel.TypeText Text:=Space(5) & "矢量面积:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=rsMS!WLM_SFVA
     Sel.TypeText Text:=Space(5) & "误差:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=rsMS!WLM_SFVAE
     Sel.TypeText Text:=Chr(10)
     
     Sel.TypeText Text:="去除文件名:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=rsMS!WLM_EFN
     Sel.TypeText Text:=Space(5) & "矢量面积:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=rsMS!WLM_EFVA
     Sel.TypeText Text:=Space(5) & "误差:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=rsMS!WLM_EFVAE
     Sel.TypeText Text:=Chr(10)
     
     Sel.TypeText Text:="人工编辑文件名:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=rsMS!WLM_MFN
     Sel.TypeText Text:=Space(5) & "矢量面积:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=rsMS!WLM_MFVA
     Sel.TypeText Text:=Space(5) & "误差:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=rsMS!WLM_MFVAE
     Sel.TypeText Text:=Chr(10)
     
     Sel.TypeText Text:="细小地物数:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=rsMS!WLM_SON
     Sel.TypeText Text:=Space(5) & "遥感面积:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=rsMS!WLM_SOVA
     Sel.TypeText Text:=Space(5) & "误差:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=rsMS!WLM_SOVAE
     Sel.TypeText Text:=Chr(10)
     
     Sel.TypeText Text:=Space(22) & "合万亩:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=rsMS!WLM_SOVAM
     Sel.TypeText Text:=Space(5) & "误差:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=rsMS!WLM_SOVAME
     Sel.TypeText Text:=Chr(10)
     
     Sel.TypeText Text:="建议下次分类数:"
     Sel.Font.Underline = wdUnderlineDouble '下画线
     Sel.TypeText Text:=rsMS!WLM_SNCN
     Sel.TypeText Text:=Chr(10)
     
     Sel.Paragraphs.Alignment = wdAlignParagraphRight '本单元排列居右
     Sel.TypeText Text:="报告人:孙玲"
     Sel.TypeText Text:=Chr(10)
              
     rsMS.MoveNext
     Loop
     Exit Sub
PrintError:
     Sel.TypeText Text:=Space(5)
     Resume Next
     
End Sub



Private Sub cboWLP_ANB_Click()
          If cboWLP_ANB.ListIndex >= 0 Then
               txtWLP_ANB = cboWLP_ANB.Text
          End If
End Sub

Private Sub cboWLP_ANE_CLICK()
          If cboWLP_ANE.ListIndex >= 0 Then
               txtWLP_ANE = cboWLP_ANE.Text
          End If
End Sub

Private Sub cboWLP_SC_Click()
          If cboWLP_SC.ListIndex >= 0 Then
               txtWLP_SC = cboWLP_SC.Text
          End If
          
          Call SetWLP_ANB 'FILL 分类号
          
End Sub

Private Sub cmdPrint_Click()

      ' bContinue = True
           'frmPrint.Show
           
    

    'expression.MoveRight(Unit, Count, Extend)
    'expression   必选。该表达式返回一个 Selection 对象。
    'Unit   Variant 类型,可选。所选内容移动距离的度量单位。可以是下列 WdUnits 常量之一:wdCell、wdCharacter、wdWord 或 wdSentence。默认值是 wdCharacter。
    'Count   Variant 类型,可选。所选内容移动距离的单位数。默认值是 1。
    'Extend   Variant 类型,可选。可以是 wdMove 或 wdExtend。如果为 wdMove,则所选内容折叠到结束位置,并向右移动。如果为 wdExtend,则所选内容向右扩展。默认值是 wdMove。
    '说明
    '如果 Unit 为 wdCell 则 Extend 参数只能是 wdMove。
    'Set myTable = newDoc.Tables.Add(Range:=Selection.Range, NumRows:=5, _
    'NumColumns:=5)
    'myTable.Cell(1, 1).Width = PicasToPoints(1)
    'ActiveDocument.Tables(1).Rows.Alignment = wdAlignRowCenter
    'Set MyTable = ActiveDocument.Tables(1)
    'Set myRange = ActiveDocument.Range(MyTable.Cell(1, 1).Range.Start, _
    'MyTable.Cell(1, 2).Range.End)
    'myRange.Cells.Merge
    
     On Error GoTo mnuCreateWordApplication
    '如果WordAPp不存在,则建立
     If WordAPp.Visible = False Then
    '定义WORD文件
            Set WordAPp = New Word.Application
            WordAPp.Visible = True
                            'WordAPp.Documents.Open FileName:="C:\My Documents\Sales.doc"
            WordAPp.Documents.Add
            Set Doc = WordAPp.ActiveDocument
            Set Sel = WordAPp.Selection
     End If
          
     Call Print_WOPCL_P
      
           cmdExit.SetFocus
           Exit Sub

mnuCreateWordApplication:
            
            Resume Next
End Sub
 Sub SetWLP_SC() '把作物表的值赋给ComboBox控件

              cboWLP_SC.AddItem "三麦"
              cboWLP_SC.AddItem "油菜"
              cboWLP_SC.AddItem "蔬菜"
              cboWLP_SC.AddItem "大棚"
End Sub
Sub SetWLP_ANB() '把分类序号的值赋给ComboBox控件

         stSQL = "Select * from WOPCL_M where WLM_LC='" & txtMM_LC & "' AND WLM_SC='" & txtMM_SC & "' AND WLM_CLT='" & txtWLP_SC & "'"
         Set rsMS = db.OpenRecordset(stSQL)
      
' Fill cboHT
         Do Until rsMS.EOF
              cboWLP_ANB.AddItem rsMS!WLM_CLTN
              cboWLP_ANE.AddItem rsMS!WLM_CLTN
              rsMS.MoveNext
         Loop
End Sub
Private Sub cboMM_LC_Click()
          If cboMM_LC.ListIndex >= 0 Then
               txtMM_LC = cboMM_LC.Text
          End If
          Call FillCboMM_SC(Me)
          Call SetWLP_ANB 'FILL 分类号
End Sub

Private Sub cboMM_SC_Click()
          If cboMM_SC.ListIndex >= 0 Then
               txtMM_SC = cboMM_SC.Text
          End If
          
          Call SetWLP_ANB 'FILL 分类号
End Sub


Private Sub cmdExit_Click()
            frmMain.Show
            frmMain.Enabled = True
            Unload Me
End Sub

Private Sub Form_Load()

    If gstNewdatabase = "" Then gstNewdatabase = GetNewDatabase(Me)
    If gstNewdatabase = "" Then GoTo ss1 '用户没有输入数据库文件名
    
    If frmMain.mnuFileSaveAs.Enabled = False Then frmMain.mnuFileSaveAs.Enabled = True
    If frmMain.mnuFileNew.Enabled = False Then frmMain.mnuFileNew.Enabled = True

    Set db = OpenDatabase(gstNewdatabase)
    
    Call SetMM_LC(Me) 'FILL 大市
    Call SetWLP_SC 'FILL 作物
    'Call SetWLP_ANB 'FILL 分类号
    
    Exit Sub
        
ss1:
        Call Form_Unload(1)
End Sub


Private Sub Form_Unload(Cancel As Integer)
            frmMain.Enabled = True
            Unload Me
End Sub

Private Sub mnuFileBack_Click()
            frmMain.Show
            frmMain.Enabled = True
            Unload Me
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -