?? frmoutput.frm
字號:
SSPanel3.Caption = ListItem(5)
SSPanel3.Visible = True
Case 6
OutPutCostList6
SSPanel3.Caption = ListItem(6)
Case 7
OutPutCostList7
SSPanel3.Caption = ListItem(7)
Case 8
OutPutCostList8
SSPanel3.Caption = ListItem(8)
Case 9
OutPutCostList9
SSPanel3.Caption = ListItem(9)
Case 10
OutPutCostList10
SSPanel3.Caption = ListItem(10)
Case 11
OutPutCostList11
SSPanel3.Caption = ListItem(11)
' Sleep 180
SSPanel3.Caption = "正在處理...."
End Select
' FileNameTemp = Left(Label1.Caption, 4)
ProBar1.Value = k
Set Wsheet(k) = AppExcel.Worksheets(k)
Wbook.Worksheets(k).Name = ListItem(k)
For i = 1 To MSFlexGrid1.Rows
For j = 1 To MSFlexGrid1.Cols
Wsheet(k).Cells(i, j).Value = MSFlexGrid1.TextMatrix(i - 1, j - 1)
Next j
Next i
Next k
Wbook.SaveAs wenjianname
AppExcel.Application.Quit
Me.MousePointer = Default
Set AppExcel = Nothing
Set Wsheet(1) = Nothing
Set Wsheet(2) = Nothing
Set Wsheet(3) = Nothing
Set Wsheet(4) = Nothing
Set Wsheet(5) = Nothing
Set Wsheet(6) = Nothing
Set Wsheet(7) = Nothing
Set Wsheet(8) = Nothing
Set Wsheet(9) = Nothing
Set Wsheet(10) = Nothing
Set Wsheet(11) = Nothing
Set Wbook = Nothing
ProBar1.Value = 12
''\\\\\\\\\\\\\\\\\\\\\\\\\顯示excel
Answer = MsgBox("要查看導出的excel數據嗎？", vbYesNo)
If Answer = vbYes Then
Label1.Caption = "正在打開excel文件"
MousePointer = vbDefault
For i = 0 To 13
ProBar1.Value = i
Sleep 10
DoEvents
Next i
Set oleExcel = CreateObject("Excel.Application")
oleExcel.Visible = True
oleExcel.Workbooks.Open filename:=wenjianname
End If
ProBar1.Visible = 0
Else
Exit Sub
End If
End Sub
Public Sub savexlsall3(wenjianname As String)
Dim AppExcel As Object
Dim Wsheet(1 To 11) As Worksheet
Dim Wbook As Workbook
Dim oleExcel As Object
Dim i%, j%, k%
On Error Resume Next
Answer = MsgBox("請您確定您的機器上已安裝了Microsoft Excel ！", vbYesNo)
' FrmListOutput.SetFocus
If Answer = vbYes Then
Me.MousePointer = 11
Set AppExcel = CreateObject("excel.application") '有三個SHEET
ProBar1.min = 1
ProBar1.max = 6
ProBar1.Value = 1
ProBar1.Visible = True
Set Wbook = AppExcel.Workbooks.Add
Wbook.Worksheets.Add , , 3
'\\===============啟動 Microsoft Excel 程序=================\\
For k = 0 To 6
Select Case k
Case 0
SSPanel3.Visible = 0
Case 1
OutlirunTuChart
SSPanel3.Visible = True
SSPanel3.Caption = GraphItem(1)
MSFlexGrid1.Visible = True
Case 2
ZwXingKuiFengXiTuNew
SSPanel3.Visible = True
SSPanel3.Caption = GraphItem(2)
MSFlexGrid1.Visible = True
Case 3
Zwoutjingxianzhichart
SSPanel3.Visible = True
SSPanel3.Caption = GraphItem(3)
MSFlexGrid1.Visible = True
Case 4
zeiyouleizengyou
SSPanel3.Visible = True
SSPanel3.Caption = GraphItem(4)
MSFlexGrid1.Visible = True
Case 5
OutPutCostList10
OutPutCostList10
Call ZwJingXianZhiMGanTu
SSPanel3.Visible = True
SSPanel3.Caption = GraphItem(5)
MSFlexGrid1.Visible = True
Case 6
OutPutCostList10
OutPutCostList10
Call shouyilvtu
SSPanel3.Visible = True
SSPanel3.Caption = GraphItem(6)
MSFlexGrid1.Visible = True
End Select
ProBar1.Value = k
' FileNameTemp = Left(Label1.Caption, 4)
Set Wsheet(k) = AppExcel.Worksheets(k)
Wbook.Worksheets(k).Name = SSPanel3.Caption & "數據"
For i = 1 To MSFlexGrid1.Rows
For j = 1 To MSFlexGrid1.Cols
Wsheet(k).Cells(i, j).Value = MSFlexGrid1.TextMatrix(i - 1, j - 1)
Next j
Next i
Next k
Wbook.SaveAs wenjianname
SSPanel3.Caption = ""
AppExcel.Application.Quit
Me.MousePointer = Default
Set AppExcel = Nothing
Set Wsheet(1) = Nothing
Set Wsheet(2) = Nothing
Set Wsheet(3) = Nothing
Set Wsheet(4) = Nothing
Set Wsheet(5) = Nothing
Set Wsheet(6) = Nothing
Set Wbook = Nothing
ProBar1.Value = 12
''\\\\\\\\\\\\\\\\\\\\\\\\\顯示excel
Answer = MsgBox("要查看導出的excel數據嗎？", vbYesNo)
If Answer = vbYes Then
Label1.Caption = "正在打開excel文件"
MousePointer = vbDefault
For i = 0 To 13
ProBar1.Value = i
Sleep 10
DoEvents
Next i
Set oleExcel = CreateObject("Excel.Application")
oleExcel.Visible = True
oleExcel.Workbooks.Open filename:=wenjianname
End If
ProBar1.Visible = 0
Else
Exit Sub
End If
End Sub
Private Sub SSCommand2_Click() 'save all
On Error GoTo errhandler
If quxianbiaoji = 0 Then Beep
If quxianbiaoji = 1 Or quxianbiaoji = 3 Then
frmoutput.CommonDialog1.CancelError = True
frmoutput.CommonDialog1.InitDir = App.Path
1 frmoutput.CommonDialog1.Filter = "Excel文檔 (*.xls)|*.xls"
CommonDialog1.filename = "*.xls"
frmoutput.CommonDialog1.ShowSave
frmoutput.CommonDialog1.FilterIndex = 1
If Dir(frmoutput.CommonDialog1.filename) <> "" Then
Beep
msg$ = "警告：" + CommonDialog1.filename + "已經存在。" + Chr$(13) + Chr$(10) + Chr$(13) + Chr$(10) + "要替換嗎？"
xchoose = MsgBox(msg$, 49, "警告")
If xchoose = 2 Then GoTo 1
End If
If quxianbiaoji = 1 Then Call savexlsall1(CommonDialog1.filename)
If quxianbiaoji = 3 Then
Call savexlsall3(CommonDialog1.filename)
Select Case symbol
Case 1
OutlirunTuChart
MSFlexGrid1.Visible = True
Case 2
ZwXingKuiFengXiTuNew
MSFlexGrid1.Visible = True
Case 3
Call Zwoutjingxianzhichart
MSFlexGrid1.Visible = True
Case 4
Call zeiyouleizengyou
MSFlexGrid1.Visible = True
Case 5
ZwJingXianZhiMGanTu
MSFlexGrid1.Visible = True
Case 6
shouyilvtu
MSFlexGrid1.Visible = True
End Select
End If
Exit Sub
End If
If quxianbiaoji = 2 Then
frmoutput.CommonDialog1.CancelError = True
frmoutput.CommonDialog1.InitDir = App.Path
2 frmoutput.CommonDialog1.Filter = "位圖格式 (*.bmp)|*.bmp"
'frmoutput.CommonDialog1.DefaultExt = "*.bmp"
frmoutput.CommonDialog1.ShowSave
frmoutput.CommonDialog1.FilterIndex = 2
If Dir(frmoutput.CommonDialog1.filename) <> "" Then
Beep
msg$ = "警告：" + CommonDialog1.filename + "已經存在。" + Chr$(13) + Chr$(10) + Chr$(13) + Chr$(10) + "要替換嗎？"
xchoose = MsgBox(msg$, 49, "警告")
If xchoose = 2 Then GoTo 2
End If
Call savebmpall(CommonDialog1.filename)
Select Case symbol
Case 1
OutlirunTuChart
Case 2
ZwXingKuiFengXiTuNew
Case 3
Call Zwoutjingxianzhichart
Case 4
Call zeiyouleizengyou
Case 5
ZwJingXianZhiMGanTu
Case 6
shouyilvtu
End Select
Exit Sub
End If
errhandler:
End Sub
Public Sub savebmpall(bmpfile As String) '保存全部圖像
ProBar1.min = 0
ProBar1.max = 6
ProBar1.Value = 1
ProBar1.Visible = True
For k = 0 To 6
Select Case k
Case 0
SSPanel3.Visible = 0
Case 1
OutlirunTuChart
SSPanel3.Visible = True
SSPanel3.Caption = GraphItem(1)
SavePicture Picture1.Image, bmpfile
Case 2
ZwXingKuiFengXiTuNew
SSPanel3.Visible = True
SSPanel3.Caption = GraphItem(2)
SavePicture Picture1.Image, Left$(bmpfile, Len(bmpfile) - 3) & GraphItem(2) & ".bmp"
Case 3
Zwoutjingxianzhichart
SSPanel3.Visible = True
SSPanel3.Caption = GraphItem(3)
SavePicture Picture1.Image, Left$(bmpfile, Len(bmpfile) - 3) & GraphItem(3) & ".bmp"
Case 4
zeiyouleizengyou
SSPanel3.Visible = True
SSPanel3.Caption = GraphItem(4)
SavePicture Picture1.Image, Left$(bmpfile, Len(bmpfile) - 3) & GraphItem(4) & ".bmp"
Case 5
OutPutCostList10
OutPutCostList10
Call ZwJingXianZhiMGanTu
SSPanel3.Visible = True
SSPanel3.Caption = GraphItem(5)
SavePicture Picture1.Image, Left$(bmpfile, Len(bmpfile) - 3) & GraphItem(5) & ".bmp"
Case 6
OutPutCostList10
OutPutCostList10
Call shouyilvtu
SSPanel3.Visible = True
SSPanel3.Caption = GraphItem(6)
SavePicture Picture1.Image, Left$(bmpfile, Len(bmpfile) - 3) & GraphItem(6) & ".bmp"
End Select
ProBar1.Value = k
Next k
ProBar1.Visible = 0
End Sub
Private Sub SSCommand3_Click()
If quxianbiaoji = 2 Then
Set Image1.Picture = Picture1.Image
Image2.Picture = Image7.Picture: Image3.Picture = Image7.Picture: Image4.Picture = Image7.Picture: Image5.Picture = Image7.Picture: Image6.Picture = Image7.Picture
CellOrPic = False
FrmPrv.Show 1
End If
If quxianbiaoji = 1 Or quxianbiaoji = 3 Then
Call MenuZwFlexPrw
End If
End Sub
Public Sub MenuZwFlexPrw()
'FileNameTemp = Left(SSPanel.Caption, 4)
MousePointer = vbHourglass
'Call ZwTxttoHtml||||||||||||||||||
Dim i%, j%
' 若要以其他方式打開文件，必需先關閉此文件。
ZwStringGrid = ""
ZwStringGrid = ZwStringGrid & "<P" & "" & "</P>"
ZwStringGrid = ZwStringGrid & "<P" & "表1 " & ListItem(symbol1) & "</P>"
'ZwStringGrid = ZwStringGrid & "<HR>"
'ZwStringGrid = ZwStringGrid & "<PRE>最新時間" & CStr(Date) '& "</PRE>"
ZwStringGrid = ZwStringGrid & "<TABLE BORDER= 1 WIDTH=600 >"
' ZwStringGrid = ZwStringGrid & "<P align=Center><big><font face=楷體_GB2312 color=" & "#0000FF" & "><big><big> " & label1.Caption & "</big></big></font></big></P>"
ZwStringGrid = ZwStringGrid & " "
For i = 1 To MSFlexGrid1.Rows
ZwStringGrid = ZwStringGrid & "<TR>"
For j = 1 To MSFlexGrid1.Cols
If MSFlexGrid1.TextMatrix(i - 1, j - 1) <> "" Then
ZwStringGrid = ZwStringGrid & "<TD WIDTH= 86 HEIGHT=18 ALIGN=Left VALIGN=Top>" _
& "<p align=Left><font size=2>" & Trim(MSFlexGrid1.TextMatrix(i - 1, j - 1)) & "</font></p>" & "</TD>"
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -