📄 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 = "图形数据"
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) = "现金流量表" '"现金流量表"
'ListItem(7) = "现金流二表(现金流入流出表)"
ListItem(3) = "资金来源与运用表"
ListItem(7) = "借款还本付息表"
ListItem(9) = "总结表"
ListItem(8) = "损益表"
ListItem(10) = "敏感分析表"
ListItem(11) = "基准平衡分析表"
ListItem(12) = "利润图数据"
ListItem(13) = "盈亏分析图数据"
ListItem(14) = "净现值图数据"
ListItem(15) = "年增油累增油图数据"
ListItem(16) = "净现值敏感图图数据"
ListItem(17) = "内部收益敏感图数据"
GraphItem(1) = "利润图"
GraphItem(2) = "盈亏分析图"
GraphItem(3) = "净现值图"
' GraphItem(4) = "年增油累增油比例图"
GraphItem(4) = "年增油累增油图"
GraphItem(5) = "净现值敏感图"
GraphItem(6) = "内部收益敏感图"
'Chartfx1.Decimals = 0
Set Node1 = TreeView1.Nodes.Add
TreeView1.Nodes(1).Text = "经济评价表"
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 = "经济评价图"
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) = "经济评价系统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 + "已经存在。" + 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 + "已经存在。" + 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数据吗?", 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 + -