Private Function F_OutCsvFile(ipFileName As String) As Long On Error GoTo Err_Exit Dim objDyn As Object Dim strSql As String Dim strYm As String Dim intFno As Integer Dim lngCntr As Long Dim strBuff As String Dim curWk As Currency F_OutCsvFile = -1 '売掛残高データの検索 strYm = txtGetujiYm(0).Text & txtGetujiYm(1).Text strSql = "" Set objDyn = DB_Select(strSql) If OraStatus <> gcnsDB_SUCCESS Then Exit Function End If '該当データなしのときは処理終了 If objDyn.EOF Then objDyn.Close Set objDyn = Nothing F_OutCsvFile = 0 Exit Function End If 'CSVファイルに出力 intFno = FreeFile Open ipFileName For Output As #intFno lngCntr = 0 With objDyn Do Until .EOF strBuff = strYm '月次年月 strBuff = strBuff & "," & CF_CStr(.Fields("JIGYOBU_CODE").Value) '事業部コード strBuff = strBuff & "," & CF_CStr(.Fields("JIGYOBU_MEI").Value) '事業部名 '1行出力 Print #intFno,strBuff lngCntr = lngCntr + 1 .MoveNext Loop End With Close intFno objDyn.Close Set objDyn = Nothing F_OutCsvFile = lngCntr Exit Function Err_Exit: Call CS_ErrMsg("F_OutCsvFile",Err.Number,Err.Description)
End Function
-----------------------------印刷---------------------
Private Const mcnsCsvFile As String = "/G5gt0020" 'CSVファイル Private Const mcnsPrtData As String = "G5gt0020" 'レポートデータ名 Private Const mcnsPrtFile As String = "/G5gt0020.wfd" 'レポートファイル
'CSVファイル名設定 strCsvFile = gstrTempPath & mcnsCsvFile & "_" & gstrUserID & ".csv" '検索 lngRecCnt = F_OutCsvFile(strCsvFile) Screen.MousePointer = vbDefault Select Case lngRecCnt Case Is < 0 Exit Sub Case 0 MsgBox "対象となるデータがありません。",vbInformation Exit Sub End Select '印刷/プレビュー Set objRpt = CreateObject("Wfrfv.Document.1") objRpt.SetDataText mcnsPrtData,strCsvFile,","",0 objRpt.Open gstrPrintPath & mcnsPrtFile objRpt.Title = "残高表" If Index = 0 Then' objRpt.Visible = True objRpt.ShowWindow = 2 ‘预览 Else objRpt.PrintOutFromDialog ’印刷 End If (编辑:李大同)
【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容!
|