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

📄 frmoutput.frm

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

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -