frmfp.frm

广翔税务代理版打印,能制作非常复杂的报表.

      Width           =   900
   End
End
Attribute VB_Name = "frmfp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim zsbexcel As Excel.Application
Dim i As Integer
Dim fpmc(30) As String
Dim fpbm(30) As String
Const ASC_ENTER = 13 '回车
Dim gRow As Integer
Dim gCol As Integer

Private Sub Cmdback_Click()
Unload Me
End Sub

Private Sub cmdprint_Click()
'On Error GoTo errorhandler
Dim t As Integer
Dim j As Integer
Dim sum, sum1 As Integer
Set zsbexcel = New Excel.Application
 zsbexcel.Visible = True
 zsbexcel.SheetsInNewWorkbook = 1
  Set zsbworkbook = zsbexcel.Workbooks.Open(App.Path + "\" + "sheet\kyfp.xlt")
 With zsbexcel.ActiveSheet
.Range("C4").Value = Text11
If Text10 <= 25 Then
.Range("J3").Value = "第1页"
.Range("K3").Value = "（共1页）"
Else
End If
.Range("G4").Value = Text12
.Range("G3").Value = Format(DTPicker2, "yyyy-MM-dd")
sum = 0
sum1 = 0
For t = 1 To Grid1.Rows - 1
Grid1.Row = t
For j = 0 To 11
Grid1.Col = j
'If IsNull(Grid1.Text) = False Then
.Cells(t + 5, j + 1) = Grid1.Text
'End If
Next j
sum = Grid1.TextMatrix(t, 11) + sum
sum1 = Grid1.TextMatrix(t, 10) + sum1
Next t
.Cells(32, 12).Value = sum
.Cells(31, 12).Value = sum
.Cells(31, 11).Value = sum1
.Cells(32, 11).Value = sum1
.Cells(31, 2).Value = Text10 - 1
.Cells(32, 2).Value = Text10 - 1
End With
  'dd = MsgBox("yes or no", vbYesNo + vbSystemModal)
  'If dd = vbNo Then Exit Sub
 ' zsbexcel.ActiveSheet.PageSetup.Orientation = xlPortrait       'xlLandscape
  'zsbexcel.ActiveSheet.PageSetup.PaperSize = xlPaperA4
 zsbexcel.Caption = "打印预览"
 zsbexcel.ActiveWindow.SelectedSheets.PrintPreview
  'zsbexcel.ActiveSheet.PrintOut
  zsbexcel.DisplayAlerts = False
  zsbexcel.Quit
  zsbexcel.DisplayAlerts = True
  Set zsbexcel = Nothing
  Exit Sub
'errorhandler:
   ' MsgBox "请正确安装EXCEL！", vbOKOnly + vbCritical
  '  Exit Sub
End Sub

Private Sub cmdsave_Click()
'定义发票编码
Dim X As Long
X = Combo1.ListIndex
fpbmc = fpbm(X)
'定义所属日期
pdate = CStr(Format(DTPicker1, "yyyyMM"))
'保存到数据库中
 On Error Resume Next
Dim db As Database, EF As Recordset, RecStr As String
DBEngine.BeginTrans
Set db = OpenDatabase(Con, False, False, ConStr)
Set EF = db.OpenRecordset("fp", dbOpenTable)
RecStr = "Insert into fp (printDate,fpbm,fplb,fpzg,fpqh,fpzh,kyqh,kyzh,yyqh,yyzh,zf,ys,qybm) values('" & pdate & "','" & fpbmc & "','" & Trim(Combo1.Text) & "','" & Trim(Text1.Text) & "','" & Trim(Text2.Text) & "','" & Trim(Text3.Text) & "','" & Trim(Text4.Text) & "','" & Trim(Text5.Text) & "','" & Trim(Text6.Text) & "','" & Trim(Text7.Text) & "','" & Trim(Text8.Text) & "','" & Trim(Text9.Text) & "','" & frmqy.qybm & "')"
db.Execute RecStr
db.Close
DBEngine.CommitTrans
'重新导入网格
Loadfp
start
End Sub

Private Sub Command1_Click()
DeleteRecord
End Sub

Private Sub Command3_Click()
Loadfp
End Sub
Private Sub Form_Load()
Text11 = frmqy.qymc
Text12 = frmqy.nsrdjh
'定义所属日期
DTPicker1.Year = Format(Date, "yyyy")
If Format(Date, "MM") = 1 Then
DTPicker1.Year = Format(Date, "yyyy") - 1
DTPicker1.Month = 12
Else
DTPicker1.Month = Format(Date, "MM") - 1
End If
'定义打印日期
DTPicker2.Year = DTPicker1.Year
If DTPicker1.Month = 12 Then
DTPicker2.Month = DTPicker1.Month
DTPicker2.Day = 31
Else
DTPicker2.Month = DTPicker1.Month + 1
DTPicker2.Day = 1
DTPicker2 = DTPicker2 - 1
End If
Me.Left = (Screen.Width - Me.Width) / 2
Me.Top = (Screen.Height - Me.Height) / 2
LoadFplx
Loadfp
End Sub

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

Private Sub Grid1_KeyPress(KeyAscii As Integer)
Call Grid1_DblClick
End Sub

Private Sub Text1_Change()
If Len(Text1) = 10 Then
    SendKeys "{tab}"
        KeyAscii = 0
    End If
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{tab}"
        KeyAscii = 0
    End If
    
End Sub
Private Sub Text1_GotFocus()
    Text1.SelStart = 0
    Text1.SelLength = Len(Text1)
End Sub


Private Sub Text13_GotFocus()
 Text13.SelStart = 0
 Text13.SelLength = Len(Text13)
End Sub

Private Sub Text13_LostFocus()
 On Error Resume Next
Dim tmpRow As Integer
Dim tmpCol As Integer
Dim Gtext(13) As String
' Save current settings of Grid Row and col. This is needed only if
' the focus is set somewhere else in the Grid.
tmpRow = Grid1.Row
tmpCol = Grid1.Col
' Set Row and Col back to what they were before Text1_LostFocus:
Grid1.Row = gRow
Grid1.Col = gCol
Grid1.Text = Text13.Text ' Transfer text back to grid.
'保存到数据库中
For i = 1 To 12
Grid1.Col = i
Gtext(i) = Grid1.Text
Next i
'======================
 Dim db As Database, RecStr As String
  Dim EF As Recordset
    DBEngine.BeginTrans
    Set db = OpenDatabase(Con, False, False, ConStr)
    Set EF = db.OpenRecordset("fp", dbOpenTable)
    RecStr = "Update fp Set fpbm='" & Gtext(1) & "'," & "fplb='" & Gtext(2) & "'," & "fpzg='" & Gtext(3) & "'," & "fpqh='" & Gtext(4) & "'," & "fpzh='" & Gtext(5) & "'," & "kyqh='" & Gtext(6) & "'," & "kyzh='" & Gtext(7) & "'," & "yyqh='" & Gtext(8) & "'," & "yyzh='" & Gtext(9) & "'," & "zf='" & Gtext(10) & "'," & "ys='" & Gtext(11) & "'" & " Where ID=" & Val(Gtext(12))
    db.Execute RecStr
    db.Close
    DBEngine.CommitTrans
'======================
Text13.SelStart = 0 ' Return caret to beginning.
Text13.Visible = False ' Disable text box.
' Return row and Col contents:
Loadfp
Grid1.Row = tmpRow
Grid1.Col = tmpCol
Exit Sub
End Sub

Private Sub Text2_Change()
If Len(Text2) = 9 Then
    SendKeys "{tab}"
        KeyAscii = 0
    End If
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{tab}"
        KeyAscii = 0
    End If
End Sub
Private Sub Text2_GotFocus()
    Text2.SelStart = 0
    Text2.SelLength = Len(Text2)
End Sub

Private Sub Text3_Change()
If Len(Text3) = 10 Then
    SendKeys "{tab}"
        KeyAscii = 0
    End If
End Sub

Private Sub Text3_GotFocus()
    Text3.SelStart = 0
    Text3.SelLength = Len(Text3)
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{tab}"
        KeyAscii = 0
    End If
End Sub
Private Sub Text4_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{tab}"
        KeyAscii = 0
    End If
End Sub
Private Sub Text5_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{tab}"
        KeyAscii = 0
    End If
End Sub
Private Sub Text6_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{tab}"
        KeyAscii = 0
    End If
End Sub
Private Sub Text7_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{tab}"
        KeyAscii = 0
    End If
End Sub
Private Sub Text8_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{tab}"
        KeyAscii = 0
    End If
    If KeyAscii <> 8 And KeyAscii < 48 Or KeyAscii > 57 Then
        'Beep
KeyAscii = 0
    End If
End Sub
Private Sub Text9_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{tab}"
        KeyAscii = 0
    End If
    If KeyAscii <> 8 And KeyAscii < 48 Or KeyAscii > 57 Then
        'Beep
KeyAscii = 0
    End If
End Sub

Private Sub Text2_LostFocus()
Text4 = Text2
Text6 = Text2
End Sub

Private Sub Text3_LostFocus()
Text5 = Text3
Text7 = Text3
End Sub
Private Sub LoadFplx()
On Error Resume Next
Dim db As Database, EF As Recordset, X As Long, i As Long
    Set db = OpenDatabase(Con, False, False, ConStr)
    Set EF = db.OpenRecordset("fplx", dbOpenTable)
        X = EF.RecordCount
    Set EF = db.OpenRecordset("fplx", dbOpenDynaset)
    For i = 0 To X - 1
        fpmc(i) = EF.Fields(3).Value
        If Not IsNull(EF.Fields(0).Value) Then
           fpbm(i) = EF.Fields(0).Value
        End If
        Combo1.AddItem fpmc(i), i
        EF.MoveNext
    Next
     EF.Close
     db.Close
If X >= 1 Then
    Combo1.ListIndex = 0
End If
End Sub
Private Sub Loadfp()
Grid1.Clear
Grid1.FormatString = "^ 序号 |^ 发票编码 |^  发票名称 |^ 发票字轨 |^ 发票起号 |^ 发票止号 |^ 可用起号 |^ 可用止号|^ 已用起号|^ 已用止号|^ 作废|^ 遗失|^ ID"
Grid1.ColWidth(0) = (Grid1.Width / 12) - 100
Grid1.ColWidth(1) = (Grid1.Width / 12) + 550
Grid1.ColWidth(2) = (Grid1.Width / 12) + 550
Grid1.ColWidth(3) = (Grid1.Width / 12) + 550
Grid1.ColWidth(4) = (Grid1.Width / 12) + 550
Grid1.ColWidth(5) = (Grid1.Width / 12) + 550
Grid1.ColWidth(6) = (Grid1.Width / 12) + 550
Grid1.ColWidth(7) = (Grid1.Width / 12) + 550
Grid1.ColWidth(8) = (Grid1.Width / 12) + 550
Grid1.ColWidth(9) = (Grid1.Width / 12) + 550
Grid1.ColWidth(10) = (Grid1.Width / 12) - 100
Grid1.ColWidth(11) = (Grid1.Width / 12) - 100
Grid1.ColWidth(12) = 0
'定义所属时间
pdate = CStr(Format(DTPicker1, "yyyyMM"))
Dim db As Database, EF As Recordset, HH As Integer
  Set db = OpenDatabase(Con, False, False, ConStr)
    Set EF = db.OpenRecordset("fp", dbOpenTable)
    Set EF = db.OpenRecordset("Select * From fp where PrintDate= '" & pdate & "' And qybm='" & frmqy.qybm & "'", dbOpenDynaset)
        HH = 1
        If EF.EOF() Then
        Grid1.Rows = 1
        Else
        End If
        Do While Not EF.EOF()
         Grid1.Rows = HH + 1
           Grid1.Row = HH
           Grid1.Col = 0
           Grid1.CellAlignment = 7
       ' If Not IsNull(EF.Fields("xh").Value) Then
           Grid1.Text = HH ' EF.Fields("xh").Value
       ' End If
           Grid1.Row = HH
           Grid1.Col = 1
           Grid1.CellAlignment = 7
        If Not IsNull(EF.Fields("fpbm").Value) Then
           Grid1.Text = EF.Fields("fpbm").Value
        End If
           Grid1.Row = HH
           Grid1.Col = 2
           Grid1.CellAlignment = 7
         If Not IsNull(EF.Fields("fplb").Value) Then
           Grid1.Text = EF.Fields("fplb").Value
        End If
           Grid1.Row = HH
           Grid1.Col = 3
           Grid1.CellAlignment = 7
        If Not IsNull(EF.Fields("fpzg").Value) Then
           Grid1.Text = EF.Fields("fpzg").Value
        End If
           Grid1.Row = HH
           Grid1.Col = 4
           Grid1.CellAlignment = 7
        If Not IsNull(EF.Fields("fpqh").Value) Then
           Grid1.Text = EF.Fields("fpqh").Value
        End If
           Grid1.Row = HH
           Grid1.Col = 5
           Grid1.CellAlignment = 7
        If Not IsNull(EF.Fields("fpzh").Value) Then
           Grid1.Text = EF.Fields("fpzh").Value
        End If
           Grid1.Row = HH
           Grid1.Col = 6
           Grid1.CellAlignment = 7
        If Not IsNull(EF.Fields("kyqh").Value) Then
           Grid1.Text = EF.Fields("kyqh").Value
        End If
           Grid1.Row = HH
           Grid1.Col = 7
           Grid1.CellAlignment = 7
        If Not IsNull(EF.Fields("kyzh").Value) Then
           Grid1.Text = EF.Fields("kyzh").Value
        End If
           Grid1.Row = HH
           Grid1.Col = 8
           Grid1.CellAlignment = 7
        If Not IsNull(EF.Fields("yyqh").Value) Then
           Grid1.Text = EF.Fields("yyqh").Value
        End If
           Grid1.Row = HH
           Grid1.Col = 9
           Grid1.CellAlignment = 7
        If Not IsNull(EF.Fields("yyzh").Value) Then
           Grid1.Text = EF.Fields("yyzh").Value
        End If
        
           Grid1.Row = HH
           Grid1.Col = 10
           Grid1.CellAlignment = 7
        If Not IsNull(EF.Fields("zf").Value) Then
           Grid1.Text = EF.Fields("zf").Value
        End If
           Grid1.Row = HH
           Grid1.Col = 11
           Grid1.CellAlignment = 7
        If Not IsNull(EF.Fields("ys").Value) Then
           Grid1.Text = EF.Fields("ys").Value
        End If
        Grid1.Row = HH
           Grid1.Col = 12
           Grid1.CellAlignment = 7
        If Not IsNull(EF.Fields("ID").Value) Then
           Grid1.Text = EF.Fields("ID").Value
        End If
          EF.MoveNext
          HH = HH + 1
        Loop
        EF.Close
        db.Close
 Grid1.Visible = True
Text10 = HH
End Sub
Private Sub start()
Combo1.ListIndex = 0
Text1 = ""
Text2 = ""
Text3 = ""
Text4 = ""
Text5 = ""
Text6 = ""
Text7 = ""
Text8 = 0
Text9 = 0
End Sub
Private Sub DeleteRecord()
On Error Resume Next
Grid1.Col = 0
If Grid1.Text = "" Then Exit Sub
   Dim Qp As Integer
   Qp = MsgBox("真的要删除(" & Grid1.Text & ")记录吗（Y/N）？", vbYesNo + 16 + vbDefaultButton2, "确认删除")
   If Qp = 7 Then
      Exit Sub
   End If
Grid1.Col = 12
Dim db As Database, RecStr As String
    DBEngine.BeginTrans
  Set db = OpenDatabase(Con, False, False, ConStr)
      RecStr = "Delete * From fp Where ID=" & Grid1.Text
      db.Execute RecStr
      db.Close
    DBEngine.CommitTrans
  '刷新记录
 Loadfp
End Sub