yy_ptfp_rpt.dsr

基于SQL2000的企业管理MRPII,包含进销存,财务,报关等组件,VB6开发,带文档说明.

VERSION 5.00
Begin {82282820-C017-11D0-A87C-00A0C90F29FC} YY_PTFP_rPt 
   Caption         =   "普通发票打印"
   ClientHeight    =   11115
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   15240
   Icon            =   "YY_PTFP_rPt.dsx":0000
   StartUpPosition =   3  '窗口缺省
   WindowState     =   2  'Maximized
   _ExtentX        =   26882
   _ExtentY        =   19606
   SectionData     =   "YY_PTFP_rPt.dsx":1272
End
Attribute VB_Name = "YY_PTFP_rPt"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub ActiveReport_ReportStart()
Me.Toolbar.Tools.Add "转换EXCEL文档"
Me.Toolbar.Tools(Me.Toolbar.Tools.Count - 1).ID = 999
Me.E_gsmc.Caption = Trim(E_gsm)
Me.L_EMc.Caption = Trim(E_gsm)
Me.L_dizh.Caption = "地址：" + Trim(C_DizH)
Me.L_phone.Caption = "电话：" + Trim(gs_dh)
Me.L_fax.Caption = "传真：" + Trim(gs_cz)
Me.L_gsmc.Caption = Trim(c_gsmc)
End Sub
Private Sub ActiveReport_ToolbarClick(ByVal Tool As DDActiveReports.DDTool)
If Tool.ID <> 999 Then Exit Sub
miF_EXCEL_Export
End Sub
Private Sub miF_EXCEL_Export()
Dim exl As New ActiveReportsExcelExport.ARExportExcel
Dim sFile As String
Dim bSave As Boolean
main_FRM.Dialog1.CancelError = True
On Error GoTo ErrHandler
With main_FRM.Dialog1
.Filter = "FoxBase/FoxPro (*.DBF)|*.DBF|Access 8.0(*.MDB)|*.MDB|Excel 8.0(*.XLS)|*.XLS|Paradox 4.x(*.DB)|*.DB"
.DialogTitle = "导出文件为"
.CancelError = False
.FilterIndex = 3
.ShowSave
 ' MystR = StrReverse(.FileName) '注释：串取反
 ' myPos = InStr(MystR, "\") ' 注释：在反字符串中，找从左开始第一个\的位置
 ' myPatH = StrReverse(Mid(MystR, myPos)) '注释：取目录部分，并还原.
 ' MystR = StrReverse(Left(MystR, myPos - 1)) '注释：取文件名
 ' F_Name = Trim(Left(MystR, Len(MystR) - 4))
 ' Set RsExport = New Recordset
 ' Export_Str = "select 顺序号,单词,代码,代码二,代码三 into [Excel 8.0;database=" & Trim(.FileName) & "]." & F_Name & " from new_hz order by 单词"
 '.DefaultExt = "*.XLS"
If Dir(.FileName) <> "" Then
  If .FilterIndex <> 3 Then
    Kill (.FileName)
  End If
'  RsExport.Open Export_Str, Conn_Str, adOpenStatic, adLockOptimistic
'  Else
'  RsExport.Open Export_Str, Conn_Str, adOpenStatic, adLockOptimistic
End If
   exl.FileName = .FileName
   If Me.Pages.Count > 0 Then
        exl.Export Me.Pages
    ElseIf Not arv.ReportSource Is Nothing Then
        If Me.Pages.Count > 0 Then
            exl.Export Me.Pages
        End If
    End If
    Set exl = Nothing
MsgBox "导出完毕！", vbOKOnly + 64, "系统提示"
End With
ErrHandler:
Exit Sub
End Sub