frmgongzi.frm

朋友给的

  MSFlex.RowHeight(0) = rowhead
  
'设置列宽
  For i = 1 To count
    MSFlex.ColWidth(i) = NameLength(i - 1).Length
  Next i

'写入记录

        If FillRecordIntoGird(rs, NameLength(), count, MSFlex) Then
        Else
        End If


End Sub
Private Function FillRecordIntoGird(rs As ADODB.Recordset, NameLength() As ColNameLength, count As Integer, MSFlex As MSFlexGrid) As Boolean
  
  Dim i, j As Integer
  
  MSFlex.TextMatrix(1, 0) = 1
  
  If rs.EOF And rs.BOF Then
  '如果记录集为空则清首行
      For i = 1 To count
         MSFlex.TextMatrix(1, i) = ""
      Next i
  Else
      rs.MoveFirst
    '写入首行
      For i = 1 To count
        MSFlex.RowHeight(1) = 270
        If i < 17 Then
            If Not IsNull(rs(i - 1)) And rs(i - 1) <> 0 Then
               MSFlex.TextMatrix(1, i) = rs(i - 1)
            Else
               MSFlex.TextMatrix(1, i) = ""
            End If
        Else
'            MSFlex.TextMatrix(1, i) = Format(DTPdatebegin, "yyyy-mm")
        End If
        
      Next i
      '写入第二行开始的数据
      i = 2
      rs.MoveNext
      If rs.EOF Then
      Else
        Do
            MSFlex.AddItem ""
            MSFlex.RowHeight(i) = 270
            MSFlex.TextMatrix(i, 0) = i
            For j = 1 To count
               If j < 23 Then
                    If Not IsNull(rs(j - 1)) And rs(j - 1) <> 0 Then
                       MSFlex.TextMatrix(i, j) = rs(j - 1)
                    Else
                       MSFlex.TextMatrix(i, j) = ""
                    End If
               Else
'                    MSFlex.TextMatrix(i, j) = Format(DTPdatebegin, "yyyy-mm")
               End If
            Next j
            rs.MoveNext
            i = i + 1
         Loop Until rs.EOF
      End If
      
      For i = 0 To MSFlex.Rows - 2
      
'        MSFlex.Col = 4
'        MSFlex.CellBackColor = &HFFFF&
        MSFlex.Col = 5
        MSFlex.CellBackColor = &HFFFF&
        MSFlex.Col = 6
        MSFlex.CellBackColor = &HFFFF&
        MSFlex.Col = 7
        MSFlex.CellBackColor = &HFFFF&
        MSFlex.Col = 8
        MSFlex.CellBackColor = &HFFFF&
        MSFlex.Col = 9
        MSFlex.CellBackColor = &HFFFF&
        MSFlex.Col = 10
        MSFlex.CellBackColor = &HFFFF&
        MSFlex.Col = 11
        MSFlex.CellBackColor = &HFFFF&
        MSFlex.Col = 12
        MSFlex.CellBackColor = &HFFFF&
        MSFlex.Col = 13
        MSFlex.CellBackColor = &HFFFF&
        MSFlex.Col = 14
        MSFlex.CellBackColor = &HFFFF&
        MSFlex.Col = 15
        MSFlex.CellBackColor = &HFFFF&
        MSFlex.Col = 16
        MSFlex.CellBackColor = &HFFFF&
'        MSFlex.Col = 17
'        MSFlex.CellBackColor = &HFFFF&
'        MSFlex.Col = 18
'        MSFlex.CellBackColor = &HFFFF&
'        MSFlex.Col = 19
'        MSFlex.CellBackColor = &HFFFF&
'        MSFlex.Col = 20
'        MSFlex.CellBackColor = &HFFFF&
'        MSFlex.Col = 21
'        MSFlex.CellBackColor = &HFFFF&
'        MSFlex.Col = 22
'        MSFlex.CellBackColor = &HFFFF&
        
        If MSFlex.Row < MSFlex.Rows - 1 Then
            MSFlex.Row = MSFlex.Row + 1
        End If
      Next
      '最后加入一个空行以填入新数据
'      MSFlex.AddItem MSFlex.Rows
End If

    FillRecordIntoGird = True
    Exit Function
'ExitNow:
'   FillRecordIntoGird = False
End Function
Private Function GetFormartString(NameLength() As ColNameLength, count As Integer) As String

'取得格式化字符串
    Dim i, j As Integer, str As String
    
    str = "^ 序号|"
    
    For i = 0 To count - 2
    
       Select Case NameLength(i).align
    
        Case 0
           str = str & "^" & NameLength(i).name & "|"
        Case 1
           str = str & "^" & NameLength(i).name & "|"
        Case 2
           str = str & "^" & NameLength(i).name & "|"
       End Select
    
    Next i
    
    Select Case NameLength(count - 1).align
    
      Case 0
          str = str & "^" & NameLength(count - 1).name
      Case 1
          str = str & "^" & NameLength(count - 1).name
      Case 2
          str = str & "^" & NameLength(count - 1).name
    End Select
    
    GetFormartString = str
    
End Function

'Private Sub MGButton1_Click()
'
'    msfDataShow.Clear
'    Call Form_Load
'End Sub

Private Sub msfDataShow_Click()
    '显示控件在制定位置
    Cellrow = msfDataShow.Row
    Cellcol = msfDataShow.Col
    
    If Cellcol = 1 Or Cellcol = 2 Then
'        Call ShowCellEditT(Text1, msfDataShow)
    ElseIf Cellcol = 4 Then
        Call ShowCellEditT(Text1, msfDataShow)
    ElseIf Cellcol = 5 Then
        Call ShowCellEditT(Text1, msfDataShow)
    ElseIf Cellcol = 6 Then
       Call ShowCellEditT(Text1, msfDataShow)
    ElseIf Cellcol = 7 Then
        Call ShowCellEditT(Text1, msfDataShow)
     ElseIf Cellcol = 8 Then
        Call ShowCellEditT(Text1, msfDataShow)
    ElseIf Cellcol = 9 Then
        Call ShowCellEditT(Text1, msfDataShow)
    ElseIf Cellcol = 10 Then
        Call ShowCellEditT(Text1, msfDataShow)
    ElseIf Cellcol = 11 Then
        Call ShowCellEditT(Text1, msfDataShow)
    ElseIf Cellcol = 12 Then
        Call ShowCellEditT(Text1, msfDataShow)
    ElseIf Cellcol = 13 Then
        Call ShowCellEditT(Text1, msfDataShow)
    ElseIf Cellcol = 14 Then
        Call ShowCellEditT(Text1, msfDataShow)
    ElseIf Cellcol = 15 Then
        Call ShowCellEditT(Text1, msfDataShow)
   ElseIf Cellcol = 16 Then
       Call ShowCellEditT(Text1, msfDataShow)
    ElseIf Cellcol = 17 Then
        Call ShowCellEditT(Text1, msfDataShow)
     ElseIf Cellcol = 18 Then
        Call ShowCellEditT(Text1, msfDataShow)
    ElseIf Cellcol = 19 Then
        Call ShowCellEditT(Text1, msfDataShow)
    ElseIf Cellcol = 20 Then
        Call ShowCellEditT(Text1, msfDataShow)
    ElseIf Cellcol = 21 Then
        Call ShowCellEditT(Text1, msfDataShow)
    ElseIf Cellcol = 22 Then
        Call ShowCellEditT(Text1, msfDataShow)
        
    End If

End Sub

Private Sub ShowCellEditT(Text1 As TextBox, MSFlex As MSFlexGrid)
'显示文本框
With MSFlex
    Text1.Move .Left + .CellLeft, .Top + .CellTop, .CellWidth - ScaleX(1, vbPixels, vbTwips), .CellHeight - ScaleY(1, vbPixels, vbTwips)
    Text1.Text = .Text

    Text1.Visible = True
    Text1.ZOrder
    Text1.SetFocus
    
End With

End Sub

Private Sub HideCellEditorT(Text1 As TextBox, MSFlex As MSFlexGrid)
'隐藏文本框
Dim i As Long
Dim gJbgz As Long
Dim gJj As Long
On Error GoTo err1
If Text1.Visible = True Then
    If Cellrow = MSFlex.Rows - 1 And Cellcol = 1 And Trim(Text1.Text) <> "" Then
         MSFlex.AddItem MSFlex.Rows
         MSFlex.TextMatrix(Cellrow, MSFlex.Cols - 1) = "1"
         
    End If
    
    If MSFlex.TextMatrix(Cellrow, Cellcol) = Text1.Text Then
    Else
'      If MSFlex.TextMatrix(Cellrow, 8) <> "1" Then
'         MSFlex.TextMatrix(Cellrow, 8) = "2"
'      End If
      MSFlex.TextMatrix(Cellrow, Cellcol) = Text1.Text
      MSFlex.TextMatrix(Cellrow, 11) = Val(MSFlex.TextMatrix(Cellrow, 5)) + Val(MSFlex.TextMatrix(Cellrow, 6)) + Val(MSFlex.TextMatrix(Cellrow, 7)) + Val(MSFlex.TextMatrix(Cellrow, 8)) + Val(MSFlex.TextMatrix(Cellrow, 9)) + Val(MSFlex.TextMatrix(Cellrow, 10))
      MSFlex.TextMatrix(Cellrow, 16) = Val(MSFlex.TextMatrix(Cellrow, 5)) + Val(MSFlex.TextMatrix(Cellrow, 6)) + Val(MSFlex.TextMatrix(Cellrow, 7)) + Val(MSFlex.TextMatrix(Cellrow, 8)) + Val(MSFlex.TextMatrix(Cellrow, 9)) + Val(MSFlex.TextMatrix(Cellrow, 10)) - Val(MSFlex.TextMatrix(Cellrow, 12)) - Val(MSFlex.TextMatrix(Cellrow, 13)) - Val(MSFlex.TextMatrix(Cellrow, 14)) - Val(MSFlex.TextMatrix(Cellrow, 15))
'      Changed = True
    End If
    
    
    
    Text1.Visible = False
End If
Exit Sub
err1:

End Sub

Private Sub Text1_Change()
'    If ChangedBegain Then
'      msfDataShow.TextMatrix(Cellrow, Cellcol) = "2"
'    End If
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
  
  Select Case KeyAscii

    Case 13
       
       KeyAscii = 0
       GoToNextGird = True
       Text1_Validate (False)
       GoToNextGird = False
    Case 27

       Text1.Visible = False

 End Select
 End Sub
 
Private Sub Text1_Validate(Cancel As Boolean)

'有效性检查
If Text1.Visible = True Then
    If Cellrow < msfDataShow.Rows - 1 And Cellcol = 1 And Trim(Text1.Text) = "" Then
      
      If Scrolling Then
        Text1.Visible = False
      Else
        MsgBox "不能为空！", vbExclamation, "系统提示"
        Cancel = True
      End If
      
      Exit Sub
    
    ElseIf Trim(Text1.Text) <> "" And Cellcol = 1 Then
    
      If Scrolling Then
        Text1.Visible = False
      Else
        MsgBox "不能重复！请重新输入。", vbExclamation, "系统提示"
        Cancel = True
      End If
      
      Exit Sub
    
    End If
    
    Call HideCellEditorT(Text1, msfDataShow)
    
    If GoToNextGird Then
        If Cellcol > 3 And Cellcol < 16 Then
            Cellcol = Cellcol + 1
            msfDataShow.Col = Cellcol
            
        ElseIf Cellcol >= 22 Then
            If msfDataShow.Row <= msfDataShow.Rows - 2 Then
                msfDataShow.Row = msfDataShow.Row + 1
            End If
            msfDataShow.Col = 4
        End If
       
       
       msfDataShow_Click
    End If
    
End If

End Sub
Private Sub PrintGrid(MSFlexG As MSFlexGrid)

Dim xlApp As Excel.Application
Set xlApp = New Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet

Dim strSource, strDestination As String
strSource = App.Path & "\Templet.xls"
strDestination = App.Path & "\Temp.xls"
FileCopy strSource, strDestination

xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Open(strDestination)
Set xlSheet = xlBook.Worksheets(1)
Dim h As Integer
Dim i, j As Integer
h = 0
For j = 0 To MSFlexG.Rows - 2
    
    For i = 0 To MSFlexG.Cols - 1
       xlSheet.Cells(h + 1, i + 1) = MSFlexG.TextMatrix(0, i)
    Next i

    For i = 0 To MSFlexG.Cols - 1
       xlSheet.Cells(h + 2, i + 1) = MSFlexG.TextMatrix(j + 1, i)
    Next i
    h = h + 2
Next j


xlSheet.PageSetup.Orientation = xlLandscape
xlSheet.PrintPreview
xlBook.Save

xlApp.Quit

'Kill strDestination

End Sub