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

📄 水准测量.frm

📁 饮羽公路测设（glcs） 由20多个公路测量、设计、试验和施工组织设计等小软件组成。如《中桩大地坐标》可以计算不等长缓和曲线的中桩和边桩的大地坐标；《缓和曲线反算》可以根据切线长、外距长或缓和曲线长求
💻 FRM
📖 第 1 页 / 共 2 页
字号:
🔍
12 
    End Select
    
    
End Sub


Private Sub Command1_Click()
'关闭
    On Error GoTo handlerror
    
    If rjsfzc = 88 Then
        If VSFlexGrid1.TextMatrix(1, 1) = "" Then
            Unload Me
            Exit Sub
        End If
        
        frmMain.Text1 = frmMain.Text1 & vbCrLf & ""
        frmMain.Text1 = frmMain.Text1 & vbCrLf & "    《水准测量计算结果》："
        
        For i = 0 To VSFlexGrid1.Rows - 1
            If VSFlexGrid1.TextMatrix(i, 1) = "" Then Exit For
            
            If Len(VSFlexGrid1.TextMatrix(i, 0)) = 1 Then kg1 = "      "
            If Len(VSFlexGrid1.TextMatrix(i, 0)) = 2 Then kg1 = "     "
            If Len(VSFlexGrid1.TextMatrix(i, 0)) = 3 Then kg1 = "    "
            
            If Len(VSFlexGrid1.TextMatrix(i, 1)) = 0 Then kg2 = "           "
            If Len(VSFlexGrid1.TextMatrix(i, 1)) = 1 Then kg2 = "          "
            If Len(VSFlexGrid1.TextMatrix(i, 1)) = 2 Then kg2 = "         "
            If Len(VSFlexGrid1.TextMatrix(i, 1)) = 3 Then kg2 = "        "
            If Len(VSFlexGrid1.TextMatrix(i, 1)) = 4 Then kg2 = "       "
            If Len(VSFlexGrid1.TextMatrix(i, 1)) = 5 Then kg2 = "      "
            If Len(VSFlexGrid1.TextMatrix(i, 1)) = 6 Then kg2 = "     "
            If Len(VSFlexGrid1.TextMatrix(i, 1)) = 7 Then kg2 = "    "
            If Len(VSFlexGrid1.TextMatrix(i, 1)) = 8 Then kg2 = "   "
            If Len(VSFlexGrid1.TextMatrix(i, 1)) > 8 Then kg2 = "  "
            
            If Len(VSFlexGrid1.TextMatrix(i, 2)) = 0 Then kg3 = "           "
            If Len(VSFlexGrid1.TextMatrix(i, 2)) = 1 Then kg3 = "          "
            If Len(VSFlexGrid1.TextMatrix(i, 2)) = 2 Then kg3 = "         "
            If Len(VSFlexGrid1.TextMatrix(i, 2)) = 3 Then kg3 = "        "
            If Len(VSFlexGrid1.TextMatrix(i, 2)) = 4 Then kg3 = "       "
            If Len(VSFlexGrid1.TextMatrix(i, 2)) = 5 Then kg3 = "      "
            If Len(VSFlexGrid1.TextMatrix(i, 2)) = 6 Then kg3 = "     "
            If Len(VSFlexGrid1.TextMatrix(i, 2)) = 7 Then kg3 = "    "
            If Len(VSFlexGrid1.TextMatrix(i, 2)) = 8 Then kg3 = "   "
            If Len(VSFlexGrid1.TextMatrix(i, 2)) > 8 Then kg3 = "  "
            
            If Len(VSFlexGrid1.TextMatrix(i, 3)) = 0 Then kg4 = "           "
            If Len(VSFlexGrid1.TextMatrix(i, 3)) = 1 Then kg4 = "          "
            If Len(VSFlexGrid1.TextMatrix(i, 3)) = 2 Then kg4 = "         "
            If Len(VSFlexGrid1.TextMatrix(i, 3)) = 3 Then kg4 = "        "
            If Len(VSFlexGrid1.TextMatrix(i, 3)) = 4 Then kg4 = "       "
            If Len(VSFlexGrid1.TextMatrix(i, 3)) = 5 Then kg4 = "      "
            If Len(VSFlexGrid1.TextMatrix(i, 3)) = 6 Then kg4 = "     "
            If Len(VSFlexGrid1.TextMatrix(i, 3)) = 7 Then kg4 = "    "
            If Len(VSFlexGrid1.TextMatrix(i, 3)) = 8 Then kg4 = "   "
            If Len(VSFlexGrid1.TextMatrix(i, 3)) > 8 Then kg4 = "  "
            
            If Len(VSFlexGrid1.TextMatrix(i, 4)) = 0 Then kg5 = "           "
            If Len(VSFlexGrid1.TextMatrix(i, 4)) = 1 Then kg5 = "          "
            If Len(VSFlexGrid1.TextMatrix(i, 4)) = 2 Then kg5 = "         "
            If Len(VSFlexGrid1.TextMatrix(i, 4)) = 3 Then kg5 = "        "
            If Len(VSFlexGrid1.TextMatrix(i, 4)) = 4 Then kg5 = "       "
            If Len(VSFlexGrid1.TextMatrix(i, 4)) = 5 Then kg5 = "      "
            If Len(VSFlexGrid1.TextMatrix(i, 4)) = 6 Then kg5 = "     "
            If Len(VSFlexGrid1.TextMatrix(i, 4)) = 7 Then kg5 = "    "
            If Len(VSFlexGrid1.TextMatrix(i, 4)) = 8 Then kg5 = "   "
            If Len(VSFlexGrid1.TextMatrix(i, 4)) > 8 Then kg5 = "  "
            
            If Len(VSFlexGrid1.TextMatrix(i, 5)) = 0 Then kg6 = "           "
            If Len(VSFlexGrid1.TextMatrix(i, 5)) = 1 Then kg6 = "          "
            If Len(VSFlexGrid1.TextMatrix(i, 5)) = 2 Then kg6 = "         "
            If Len(VSFlexGrid1.TextMatrix(i, 5)) = 3 Then kg6 = "        "
            If Len(VSFlexGrid1.TextMatrix(i, 5)) = 4 Then kg6 = "       "
            If Len(VSFlexGrid1.TextMatrix(i, 5)) = 5 Then kg6 = "      "
            If Len(VSFlexGrid1.TextMatrix(i, 5)) = 6 Then kg6 = "     "
            If Len(VSFlexGrid1.TextMatrix(i, 5)) = 7 Then kg6 = "    "
            If Len(VSFlexGrid1.TextMatrix(i, 5)) = 8 Then kg6 = "   "
            If Len(VSFlexGrid1.TextMatrix(i, 5)) > 8 Then kg6 = "  "
            If i = 0 Then frmMain.Text1 = frmMain.Text1 & vbCrLf & "   " + VSFlexGrid1.TextMatrix(i, 0) + "    " + VSFlexGrid1.TextMatrix(i, 1) + "       " + VSFlexGrid1.TextMatrix(i, 2) + "       " + VSFlexGrid1.TextMatrix(i, 3) + "       " + VSFlexGrid1.TextMatrix(i, 4) + "       " + VSFlexGrid1.TextMatrix(i, 5) + "     " + VSFlexGrid1.TextMatrix(i, 6)
            If i <> 0 Then frmMain.Text1 = frmMain.Text1 & vbCrLf & "    " + VSFlexGrid1.TextMatrix(i, 0) + kg1 + VSFlexGrid1.TextMatrix(i, 1) + kg2 + VSFlexGrid1.TextMatrix(i, 2) + kg3 + VSFlexGrid1.TextMatrix(i, 3) + kg4 + VSFlexGrid1.TextMatrix(i, 4) + kg5 + VSFlexGrid1.TextMatrix(i, 5) + kg6 + VSFlexGrid1.TextMatrix(i, 6)
        Next i
        frmMain.Text1 = frmMain.Text1 & vbCrLf & "    --------------------------------------"
    End If
    
    Unload Me
    
    Exit Sub
handlerror:
    
End Sub

Private Sub Command2_Click()
'到EXCEL
Dim xlApp As Excel.Application

On Error GoTo handlerror
    
    Set xlApp = New Excel.Application
        
    Set xlApp = CreateObject("Excel.Application")
    '激活EXCEL应用程序
    xlApp.Visible = True  '隐藏EXCEL应用程序窗口
    Set xlBook = xlApp.Workbooks.Add
    '打开工作簿，strDestination为一个EXCEL报表文件
    Set xlsheet = xlBook.Worksheets(1)
        
    xlsheet.Range("A1:G1").MergeCells = True
        
    For i = 0 To VSFlexGrid1.Rows - 1
        For j = 0 To VSFlexGrid1.Cols - 1
            xlsheet.Cells(i + 3, j + 1) = VSFlexGrid1.TextMatrix(i, j)
        Next j
    Next i
        
    xlsheet.PageSetup.Orientation = xlPortrait
    xlsheet.PageSetup.PaperSize = xlPaperA4
    xlsheet.PageSetup.PrintTitleRows = "$1:$3"
    With xlsheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0.590551181102362)
        .RightMargin = Application.InchesToPoints(0.590551181102362)
        .TopMargin = Application.InchesToPoints(0.78740157480315)
        .BottomMargin = Application.InchesToPoints(0.590551181102362)
        .HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .CenterHorizontally = True
    '        .CenterVertically = True
    End With
        
    xlsheet.Columns(1).ColumnWidth = 5
    xlsheet.Columns(2).ColumnWidth = 15
    xlsheet.Columns(3).ColumnWidth = 8
    xlsheet.Columns(4).ColumnWidth = 8
    xlsheet.Columns(5).ColumnWidth = 8
    xlsheet.Columns(6).ColumnWidth = 9
    xlsheet.Columns(7).ColumnWidth = 9
    
    xlsheet.Columns(1).HorizontalAlignment = xlCenter
    xlsheet.Columns(1).VerticalAlignment = xlCenter
    xlsheet.Columns(2).HorizontalAlignment = xlCenter
    xlsheet.Columns(2).VerticalAlignment = xlCenter
    xlsheet.Columns(3).HorizontalAlignment = xlCenter
    xlsheet.Columns(3).VerticalAlignment = xlCenter
    xlsheet.Columns(4).HorizontalAlignment = xlCenter
    xlsheet.Columns(4).VerticalAlignment = xlCenter
    xlsheet.Columns(5).HorizontalAlignment = xlCenter
    xlsheet.Columns(5).VerticalAlignment = xlCenter
    xlsheet.Columns(6).HorizontalAlignment = xlCenter
    xlsheet.Columns(6).VerticalAlignment = xlCenter
    xlsheet.Columns(7).HorizontalAlignment = xlCenter
    xlsheet.Columns(7).VerticalAlignment = xlCenter
        
    xlsheet.Cells(1, 1) = "水准测量计算结果"
    xlsheet.Rows(3).WrapText = True
    xlsheet.Range(xlsheet.Cells(3, 1), xlsheet.Cells(i + 2, j)).Borders.LineStyle = xlContinuous
    xlsheet.Range(xlsheet.Cells(3, 1), xlsheet.Cells(i + 2, j)).Borders.Weight = xlThin
        
    xlsheet.Range("A1:G1").MergeCells = True
    xlsheet.Range("A1:G1").HorizontalAlignment = xlCenter
    xlsheet.Range("A1:G1").VerticalAlignment = xlCenter
    xlsheet.Range(xlsheet.Cells(1, 1), xlsheet.Cells(1, 7)).Font.Name = "宋体"
    xlsheet.Range(xlsheet.Cells(1, 1), xlsheet.Cells(1, 7)).Font.Bold = True
    xlsheet.Range(xlsheet.Cells(1, 1), xlsheet.Cells(1, 7)).Font.Size = 20
    xlsheet.Range(xlsheet.Cells(2, 1), xlsheet.Cells(i + 4, 7)).Font.Size = 10
    
    
    
    Exit Sub
handlerror:
    xianshi = MsgBox("在打印到EXCEL出错，请再试试。", vbInformation, "问题提示")
    
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
'Esc键退出，VbEscape可以用27代替
    On Error GoTo handlerror

    If KeyAscii = 27 Then
        Unload Me
    End If
    
    Exit Sub
handlerror:

End Sub

Private Sub Form_Load()
'启动
    On Error GoTo handlerror

    With VSFlexGrid1
        .TextMatrix(0, 0) = "序号"
        .TextMatrix(0, 1) = "测点"
        .TextMatrix(0, 2) = "后视"
        .TextMatrix(0, 3) = "中视"
        .TextMatrix(0, 4) = "前视"
        .TextMatrix(0, 5) = "仪器高"
        .TextMatrix(0, 6) = "高程"
        .ColWidth(0) = 500
        .ColWidth(1) = 1100
        .ColWidth(2) = 800
        .ColWidth(3) = 800
        .ColWidth(4) = 800
        .ColWidth(5) = 950
        .ColWidth(6) = 950
        .ColAlignment(0) = flexAlignCenterCenter
        .ColAlignment(1) = flexAlignCenterCenter
        .ColAlignment(2) = flexAlignCenterCenter
        .ColAlignment(3) = flexAlignCenterCenter
        .ColAlignment(4) = flexAlignCenterCenter
        .ColAlignment(5) = flexAlignCenterCenter
        .ColAlignment(6) = flexAlignCenterCenter
        .RowHeight(0) = 300
    End With
    
    Exit Sub
handlerror:

End Sub

Private Sub VSFlexGrid1_AfterEdit(ByVal Row As Long, ByVal Col As Long)
'编辑文件后
    
    On Error GoTo handlerror

    Call bg1yd
    
    Exit Sub
handlerror:
    
End Sub

Private Sub VSFlexGrid1_AfterRowColChange(ByVal OldRow As Long, ByVal OldCol As Long, ByVal NewRow As Long, ByVal NewCol As Long)
'表格移动
    
    On Error GoTo handlerror

    Call bg1yd
    
    Exit Sub
handlerror:
    
End Sub


Public Sub bg1yd()
'表格1移动
    On Error GoTo handlerror

    j = 1
    For i = 1 To VSFlexGrid1.Rows - 1
        VSFlexGrid1.TextMatrix(i, 0) = i
        If VSFlexGrid1.TextMatrix(i, 1) = "" Then
            j = i
            Exit For
        End If
    Next i
    If j >= VSFlexGrid1.Rows - 3 Then
        VSFlexGrid1.Rows = j + 2
    End If
    
    For i = 1 To VSFlexGrid1.Rows - 1
        If VSFlexGrid1.TextMatrix(i, 2) <> "" And VSFlexGrid1.TextMatrix(i, 3) <> "" Then
            xiansh = MsgBox("请检查输入的数据，然后再输入。", vbInformation, "问题提示")
            VSFlexGrid1.TextMatrix(i, 3) = ""
        End If
        If VSFlexGrid1.TextMatrix(i, 3) <> "" And VSFlexGrid1.TextMatrix(i, 4) <> "" Then
            xiansh = MsgBox("请检查输入的数据，然后再输入。", vbInformation, "问题提示")
            VSFlexGrid1.TextMatrix(i, 4) = ""
        End If
        If VSFlexGrid1.TextMatrix(i, 2) <> "" And VSFlexGrid1.TextMatrix(i, 3) <> "" And VSFlexGrid1.TextMatrix(i, 4) <> "" Then
            xiansh = MsgBox("请检查输入的数据，然后再输入。", vbInformation, "问题提示")
            VSFlexGrid1.TextMatrix(i, 3) = ""
        End If
        If VSFlexGrid1.TextMatrix(i, 4) <> "" Then
            VSFlexGrid1.TextMatrix(i, 6) = Int((yg - Val(VSFlexGrid1.TextMatrix(i, 4))) * 1000 + 0.5) / 1000
        End If
        If VSFlexGrid1.TextMatrix(i, 2) <> "" Then
            VSFlexGrid1.TextMatrix(i, 5) = Int((Val(VSFlexGrid1.TextMatrix(i, 2)) + Val(VSFlexGrid1.TextMatrix(i, 6))) * 1000 + 0.5) / 1000
            yg = Val(VSFlexGrid1.TextMatrix(i, 5))
        End If
        If VSFlexGrid1.TextMatrix(i, 3) <> "" Then
            VSFlexGrid1.TextMatrix(i, 6) = Int((yg - Val(VSFlexGrid1.TextMatrix(i, 3))) * 1000 + 0.5) / 1000
        End If
    Next i
    
    Exit Sub
handlerror:
    
End Sub
12

⌨️ 快捷键说明

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