⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmoutput.frm

📁 用于三次采油技术的经济评价
💻 FRM
📖 第 1 页 / 共 5 页
字号:
            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 + -