form2.frm

全站仪计算仪器加乘常数

     MSFlexGrid1.TextMatrix(26, i) = "加常数中误差Mc=" & Format(mk, "0.000") & "mm       乘常数中误差Mk=" & Format(mr * 1000, "0.000") & "mm/km" & "    测距中误差M0=" & Format(m0, "0.000") & "mm"
Next i
MSFlexGrid1.MergeRow(26) = True
     MSFlexGrid1.MergeCells = flexMergeFree
     

End Sub

Private Sub MSFlexGrid1_LeaveCell()
Dim j As Integer
        'ReDim zhuanzhejiao1(MSFlexGrid1.Rows - 1)
        ' Save current settings of Grid Row and col. This is needed only if
        ' the focus is set somewhere else in the Grid.
'        tmpRow = MSFlexGrid1.Row
'        tmpCol = MSFlexGrid1.Col
        ' Set Row and Col back to what they were before text1_LostFocus:
        MSFlexGrid1.Row = grow
        MSFlexGrid1.Col = gcol
        
        X1 = Text1.Text
        If grow < 3 And grow > 0 Then
        For j = 0 To 4
                 MSFlexGrid1.TextMatrix(grow, j) = X1
     Next j

        
        Else
         MSFlexGrid1.TextMatrix(grow, gcol) = X1
        End If
        Text1.SelStart = 0 ' Return caret to beginning.
        Text1.Visible = False ' Disable text box.
14:
End Sub

Private Sub MSFlexGrid1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
' Move the text box to the current grid cell:
Text1.Top = MSFlexGrid1.CellTop + MSFlexGrid1.Top
Text1.Left = MSFlexGrid1.CellLeft + MSFlexGrid1.Left
' Save the position of the grids Row and Col for later:
grow = MSFlexGrid1.Row
gcol = MSFlexGrid1.Col
' Make text box same size as current grid cell:
Text1.Width = MSFlexGrid1.CellWidth - 2 * Screen.TwipsPerPixelX
Text1.Height = MSFlexGrid1.CellHeight - 2 * Screen.TwipsPerPixelY
' Transfer the grid cell text:
Text1.Text = MSFlexGrid1.Text
' Show the text box:
Text1.Visible = True
Text1.ZOrder 0 ' 把 text1 放到最前面！
Text1.SetFocus
' Redirect this KeyPress event to the text box:
'If KeyAscii <> ASC_ENTER Then
'SendKeys Chr$(KeyAscii)
'End If
End Sub


Private Sub open_Click()
Dim mynumber As String
CommonDialog1.ShowOpen
Dim mystr() As String
Dim i As Integer
Dim j As Integer
filename = CommonDialog1.filename
For j = 1 To 21
MSFlexGrid1.TextMatrix(j + 3, 1) = ""
Next j
Open filename For Input As #1
i = 1
Do While Not EOF(1)
Line Input #1, mynumber
mystr = Split(mynumber, ",")
If i > 1 Then
For j = 1 To 2
MSFlexGrid1.TextMatrix(i + 2, j) = mystr(j)
Next j
End If
i = i + 1
Loop
n = i - 2
Close #1
JS.Enabled = True

End Sub

Private Sub report_Click()

CommonDialog1.Filter = "*.xls|*.xls"
CommonDialog1.ShowSave
filename = CommonDialog1.filename
If filename <> "" Then

'On Error GoTo 10:
Set xlapp = CreateObject("Excel.Application")
'excelisrun = True
'End If
    Set xlapp = CreateObject("Excel.Application") '创建EXCEL应用类
    Form1.ProgressBar1.Value = 10
 xlapp.Visible = False '设置EXCEL可见
    
    
   Set xlBook = xlapp.Workbooks.Add '打开EXCEL工作簿
    Set xlsheet = xlBook.Worksheets(1) '打开EXCEL工作表
    xlsheet.Activate '激活工作表
    xlBook.Activate
    '*************************************************
'    xlapp.Rows("1:17").Select
'    xlapp.Selection.Borders(5).LineStyle = -4142
'    xlapp.Selection.Borders(6).LineStyle = -4142
i1 = 1

sT = Chr(65) & 1 & ":" & Chr(64 + 6) & 1
Form1.ProgressBar1.Value = 20
    xlapp.Range(sT).Select
    With xlapp.Selection
        .HorizontalAlignment = -4108
       .VerticalAlignment = -4108
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = True
    End With
sT = Chr(65) & 2 & ":" & Chr(64 + 6) & 2
    xlapp.Range(sT).Select
    With xlapp.Selection
        .HorizontalAlignment = -4131
       .VerticalAlignment = -4108
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = True
    End With
sT = Chr(65) & 3 & ":" & Chr(64 + 6) & 3
    xlapp.Range(sT).Select
    With xlapp.Selection
        .HorizontalAlignment = -4131
       .VerticalAlignment = -4108
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = True
    End With
    sT = Chr(65) & 28 & ":" & Chr(64 + 6) & 28
    xlapp.Range(sT).Select
    With xlapp.Selection
        .HorizontalAlignment = -4152
       .VerticalAlignment = -4108
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = True
    End With
    sT = Chr(65) & 26 & ":" & Chr(64 + 6) & 26

    xlapp.Range(sT).Select
    With xlapp.Selection
        .HorizontalAlignment = -4108
       .VerticalAlignment = -4108
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = True
    End With
    sT = Chr(65) & 27 & ":" & Chr(64 + 6) & 27

    xlapp.Range(sT).Select
    With xlapp.Selection
        .HorizontalAlignment = -4108
       .VerticalAlignment = -4108
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = True
    End With
    sT = Chr(65) & 4 & ":" & Chr(64 + 6) & 25
    xlapp.Range(sT).Select
    With xlapp.Selection
        .HorizontalAlignment = -4108
       .VerticalAlignment = -4108
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
    End With
     
     xlapp.Range("A26:F28").Select
    With xlapp.Selection.Font
        .Name = "宋体"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
    End With
  xlapp.Range("A2:F3").Select
    With xlapp.Selection.Font
        .Name = "宋体"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = True
        .Underline = 2
        .Shadow = False
    End With
    '************************************************
    
    For j = 1 To 6
    

    For i = 1 To 28
     xlsheet.cells(i, j) = Trim(MSFlexGrid1.TextMatrix(i - 1, j - 1)) '给单元格1行驶列赋值
   Next

   Next
   xlapp.Columns("A:F").ColumnWidth = 12
   xlapp.Columns("D:D").ColumnWidth = 8
   xlapp.Columns("F:F").ColumnWidth = 12
   sT = Chr(65) & 1 & ":" & Chr(65 + 5) & 28
       xlapp.Range("A1:F28").Select
    xlapp.Selection.Borders(5).LineStyle = -4142
    xlapp.Selection.Borders(6).LineStyle = -4142
    xlapp.Selection.Borders(7).LineStyle = -4142
    xlapp.Selection.Borders(8).LineStyle = -4142
    xlapp.Selection.RowHeight = 24
    With xlapp.Selection.Borders(9)
        .LineStyle = 1
        .Weight = 2
        .ColorIndex = xlAutomatic
    End With
    xlapp.Selection.Borders(10).LineStyle = -4142
    xlapp.Selection.Borders(11).LineStyle = -4142
    xlapp.Selection.Borders(12).LineStyle = -4142
    xlapp.Selection.Borders(5).LineStyle = -4142
    xlapp.Selection.Borders(6).LineStyle = -4142
    With xlapp.Selection.Borders(7)
        .LineStyle = 1
        .Weight = 2
        .ColorIndex = xlAutomatic
    End With
    With xlapp.Selection.Borders(8)
        .LineStyle = xlContinuous
        .Weight = 2
        .ColorIndex = xlAutomatic
        
    End With
   
    With xlapp.Selection.Borders(9)
        .LineStyle = xlContinuous
        .Weight = 2
        .ColorIndex = xlAutomatic
    End With
    With xlapp.Selection.Borders(10)
        .LineStyle = xlContinuous
        .Weight = 2
        .ColorIndex = xlAutomatic
    End With
    With xlapp.Selection.Borders(11)
        .LineStyle = xlContinuous
        .Weight = 2
        .ColorIndex = xlAutomatic
    End With
    With xlapp.Selection.Borders(12)
        .LineStyle = xlContinuous
        .Weight = 2
        .ColorIndex = xlAutomatic
    End With
 
        xlsheet.saveas (filename)
        xlBook.Close (True) '关闭EXCEL工作簿
    xlapp.Quit '关闭EXCEL
    Else
    Exit Sub
    End If

10:
End Sub

Private Sub save_Click()
Dim i As Integer
Dim j As Integer
CommonDialog1.ShowSave
filename = CommonDialog1.filename
Open filename For Output As #1
For i = 3 To 24

Print #1, MSFlexGrid1.TextMatrix(i, 0) & "," & MSFlexGrid1.TextMatrix(i, 1) & "," & MSFlexGrid1.TextMatrix(i, 2)
'Print #1, Chr(10) & Chr(13)
Next i


Close #1
End Sub



Private Sub text1_KeyPress(KeyAscii As Integer)
If KeyAscii = ASC_ENTER Then

MSFlexGrid1.SetFocus ' Set focus back to grid, see Text_LostFocus.
KeyAscii = 0 ' Ignore this KeyPress.
End If
End Sub
Private Sub msflexgrid1_KeyPress(KeyAscii As Integer)
' Move the text box to the current grid cell:
Text1.Top = MSFlexGrid1.CellTop + MSFlexGrid1.Top
Text1.Left = MSFlexGrid1.CellLeft + MSFlexGrid1.Left
' Save the position of the grids Row and Col for later:
grow = MSFlexGrid1.Row
gcol = MSFlexGrid1.Col
' Make text box same size as current grid cell:
Text1.Width = MSFlexGrid1.CellWidth - 2 * Screen.TwipsPerPixelX
Text1.Height = MSFlexGrid1.CellHeight - 2 * Screen.TwipsPerPixelY
' Transfer the grid cell text:
Text1.Text = MSFlexGrid1.Text
' Show the text box:
Text1.Visible = True
Text1.ZOrder 0 ' 把 text1 放到最前面！
Text1.SetFocus
' Redirect this KeyPress event to the text box:
If KeyAscii <> ASC_ENTER Then
SendKeys Chr$(KeyAscii)
End If
End Sub
Private Sub text1_LostFocus()
'Dim tmpRow As Integer
'Dim tmpCol As Integer
Dim j As Integer
        'ReDim zhuanzhejiao1(MSFlexGrid1.Rows - 1)
        ' Save current settings of Grid Row and col. This is needed only if
        ' the focus is set somewhere else in the Grid.
'        tmpRow = MSFlexGrid1.Row
'        tmpCol = MSFlexGrid1.Col
        ' Set Row and Col back to what they were before text1_LostFocus:
        MSFlexGrid1.Row = grow
        MSFlexGrid1.Col = gcol
        
        X1 = Text1.Text
        If grow < 3 And grow > 0 Then
        For j = 0 To 4
                 MSFlexGrid1.TextMatrix(grow, j) = X1
     Next j

        
        Else
         MSFlexGrid1.TextMatrix(grow, gcol) = X1
        End If
        Text1.SelStart = 0 ' Return caret to beginning.
        Text1.Visible = False ' Disable text box.
'        MSFlexGrid1.Row = tmpRow
'        MSFlexGrid1.Col = tmpCol
        
14:
End Sub