?? frmoutput.frm
字號:
Name = "宋體"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin Threed.SSCommand SSCommand4
Height = 615
Left = 11280
TabIndex = 11
Top = 8160
Width = 1095
_Version = 65536
_ExtentX = 1931
_ExtentY = 1085
_StockProps = 78
Caption = "打印全部"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋體"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin Threed.SSCommand SSCommand1
Height = 615
Left = 8040
TabIndex = 12
Top = 8160
Width = 1095
_Version = 65536
_ExtentX = 1931
_ExtentY = 1085
_StockProps = 78
Caption = "保存當前"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋體"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin Threed.SSCommand SSCommand5
Height = 615
Left = 13440
TabIndex = 13
Top = 8160
Width = 1095
_Version = 65536
_ExtentX = 1931
_ExtentY = 1085
_StockProps = 78
Caption = "退出"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋體"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin Threed.SSCommand SSCommand6
Height = 615
Left = 12360
TabIndex = 15
Top = 8160
Width = 1095
_Version = 65536
_ExtentX = 1931
_ExtentY = 1085
_StockProps = 78
Caption = "圖形數(shù)據(jù)"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋體"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Enabled = 0 'False
End
End
End
Attribute VB_Name = "frmoutput"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim ListItem(1 To 20) As String
Dim Answer$
Dim ttt As Integer
Dim GraphItem(1 To 20) As String
Dim symbol, symbol1 As Integer
Dim quxianbiaoji As Integer
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Form_Load()
ReDim grpoint(grnum_max), gr_type(grnum_max), grnote_visible(grnum_max), grnote_LR(grnum_max)
ReDim grnote_name$(grnum_max)
ReDim Lstyle(grnum_max), Lwidth(grnum_max), Lcolor(grnum_max)
ReDim Pstyle(grnum_max), Pwidth(grnum_max), Pcolor(grnum_max)
ReDim grdatx(grnum_max, grpoint_max), grdaty(grnum_max, grpoint_max)
ProBar1.Visible = 1
Dim Node1 As Node, Node2 As Node, Node3 As Node
Dim Node4 As Node, Node5 As Node
Dim i%
ListItem(2) = "成本表"
'ListItem(2) = "成本表"
ListItem(1) = "藥劑費用表"
ListItem(4) = "投資表"
ListItem(5) = "稅額表"
ListItem(6) = "現(xiàn)金流量表" '"現(xiàn)金流量表"
'ListItem(7) = "現(xiàn)金流二表(現(xiàn)金流入流出表)"
ListItem(3) = "資金來源與運用表"
ListItem(7) = "借款還本付息表"
ListItem(9) = "總結(jié)表"
ListItem(8) = "損益表"
ListItem(10) = "敏感分析表"
ListItem(11) = "基準平衡分析表"
ListItem(12) = "利潤圖數(shù)據(jù)"
ListItem(13) = "盈虧分析圖數(shù)據(jù)"
ListItem(14) = "凈現(xiàn)值圖數(shù)據(jù)"
ListItem(15) = "年增油累增油圖數(shù)據(jù)"
ListItem(16) = "凈現(xiàn)值敏感圖圖數(shù)據(jù)"
ListItem(17) = "內(nèi)部收益敏感圖數(shù)據(jù)"
GraphItem(1) = "利潤圖"
GraphItem(2) = "盈虧分析圖"
GraphItem(3) = "凈現(xiàn)值圖"
' GraphItem(4) = "年增油累增油比例圖"
GraphItem(4) = "年增油累增油圖"
GraphItem(5) = "凈現(xiàn)值敏感圖"
GraphItem(6) = "內(nèi)部收益敏感圖"
'Chartfx1.Decimals = 0
Set Node1 = TreeView1.Nodes.Add
TreeView1.Nodes(1).Text = "經(jīng)濟評價表"
TreeView1.Nodes(1).Key = "表"
TreeView1.Nodes(1).Image = "open"
TreeView1.Nodes(1).Expanded = 1
For i = 1 To 11
Set Node2 = TreeView1.Nodes.Add("表", tvwChild, ListItem(i))
TreeView1.Nodes(i + 1).Text = ListItem(i)
TreeView1.Nodes(i + 1).Key = ListItem(i)
TreeView1.Nodes(i + 1).Image = "leaf"
' TreeView1.Nodes(I + 1).Expanded = True
TreeView1.Nodes(2).Image = "kit"
TreeView1.Nodes(2).Expanded = True
Next i
Set Node2 = TreeView1.Nodes.Add
TreeView1.Nodes(13).Text = "經(jīng)濟評價圖"
TreeView1.Nodes(13).Key = "圖"
TreeView1.Nodes(13).Image = "close"
TreeView1.Nodes(13).Expanded = 0
For i = 1 To 6
Set Node3 = TreeView1.Nodes.Add("圖", tvwChild, GraphItem(i))
TreeView1.Nodes(i + 13).Text = GraphItem(i)
TreeView1.Nodes(i + 13).Key = GraphItem(i)
TreeView1.Nodes(i + 13).Image = "leaf"
Next i
'OpeningDatabase = App.Path & "\11.mdo"
OpenShengChengList
OpenHuaXueJiList
OpenTouZiList
OpenQiTaList
If VarPingJiaQi <= VarQiTa(9) Then
VarPingJiaQi = VarQiTa(9)
Else
MsgBox "評價期年限有誤,將默認為" & VarPingJiaQi & "年", 0, "ERRO!"
End If
CostList1Cacul
SSPanel3.Visible = 0: ProBar1.Visible = 0: CellOrPic = True: Picture1.Visible = False: ttt = 0
StatusBar1.Panels(1) = "項目文件：" & OpeningDatabase: StatusBar1.Panels(2) = "經(jīng)濟評價系統(tǒng)1.0"
symbol1 = 0
symbol = 0
quxianbiaoji = 0
MSFlexGrid1.Visible = 0
OutPutCostList1
quxianbiaoji = 1: symbol1 = 1
MSFlexGrid1.RowHeightMin = 500
MSFlexGrid1.HighLight = flexHighlightAlways
MSFlexGrid1.FontWidth = 5
MSFlexGrid1.row = 0
For i = 0 To MSFlexGrid1.Cols - 1
MSFlexGrid1.col = i
MSFlexGrid1.CellAlignment = flexAlignCenterCenter
Next i
End Sub
Private Sub SSCommand1_Click() '保存
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 + "已經(jīng)存在。" + Chr$(13) + Chr$(10) + Chr$(13) + Chr$(10) + "要替換嗎？"
xchoose = MsgBox(msg$, 49, "警告")
If xchoose = 2 Then GoTo 1
End If
Call savexls(CommonDialog1.filename)
' savexls (CommonDialog1.filename)
Exit Sub
End If
If quxianbiaoji = 2 Then
'On Error GoTo errhandler
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 + "已經(jīng)存在。" + Chr$(13) + Chr$(10) + Chr$(13) + Chr$(10) + "要替換嗎？"
xchoose = MsgBox(msg$, 49, "警告")
If xchoose = 2 Then GoTo 2
End If
SavePicture Picture1.Image, CommonDialog1.filename
Exit Sub
End If
errhandler:
End Sub
Public Sub savexls(wenjianname As String)
Dim AppExcel As Object
Dim Wsheet(1 To 3) 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 = 12
ProBar1.Value = 1
ProBar1.Visible = True
Set Wbook = AppExcel.Workbooks.Add
'\\===============啟動 Microsoft Excel 程序=================\\
Set Wsheet(1) = AppExcel.Worksheets(1)
Wbook.Worksheets(1).Name = ListItem(symbol1)
For i = 1 To MSFlexGrid1.Rows
For j = 1 To MSFlexGrid1.Cols
Wsheet(1).Cells(i, j).Value = MSFlexGrid1.TextMatrix(i - 1, j - 1)
Next j
Next i
Wbook.SaveAs wenjianname
AppExcel.Application.Quit
Me.MousePointer = Default
Set AppExcel = Nothing
Set Wsheet(1) = Nothing
Answer = MsgBox("要查看導出的excel數(shù)據(jù)嗎？", 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 savexlsall1(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 = 12
ProBar1.Value = 1
ProBar1.Visible = True
Set Wbook = AppExcel.Workbooks.Add
Wbook.Worksheets.Add , , 8
'\\===============啟動 Microsoft Excel 程序=================\\
For k = 0 To 11
Select Case k
Case 0
SSPanel3.Visible = False
Case 1
OutPutCostList1
SSPanel3.Visible = True
SSPanel3.Caption = ListItem(1)
Case 2
OutPutCostList2
SSPanel3.Caption = ListItem(2)
SSPanel3.Visible = True
Case 3
OutPutCostList3
SSPanel3.Caption = ListItem(3)
SSPanel3.Visible = True
Case 4
OutPutCostList4
SSPanel3.Caption = ListItem(4)
SSPanel3.Visible = True
Case 5
OutPutCostList5
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -