Excel精英培训网

 找回密码
 注册

QQ登录

只需一步,快速开始

你正在寻找更好的Excel学习教程吗?Excel技巧80集+数据透视表+函数初中高全套+VBA80集,想学的这儿全都有
查看: 69|回复: 4

[求助] 请教系统错误&H8000FFFF灾难性故障

[复制链接]
发表于 2017-8-10 10:42 | 显示全部楼层 |阅读模式
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
大侠:
我的VBA工程添加以下程序后就出现了系统错误&H8000FFFF灾难性故障,然后里面的窗体全消失不见了.
我电脑及系统配置是WIN7和OFFICE2007
1)公共模块里的函数
Function WorkbookOpen(WorkBookName As String) As Boolean
  WorkbookOpen = False  '如果该工作簿已打开则返回真
  On Error GoTo 1111:
  If VBA.Len(Application.Workbooks(WorkBookName).Name) > 0 Then
    WorkbookOpen = True
    Exit Function
  End If
1111:
End Function

2)窗体新添加的程序
Private Sub Commad_导出_Click()
Dim R As Long
Dim LuJin, AAA, MM, WBname As String
Dim XXX, Ws As Object
Dim DT As Date
Dim Sh As Shape
MM = ActiveSheet.Name
DT = VBA.Date
R = ThisWorkbook.Sheets(MM).Range("A65535").End(xlUp).Row
Unload Form_报表查询窗口
LuJin = VBA.CreateObject("WScript.Shell").SpecialFolders("Desktop")
Set XXX = VBA.CreateObject("Scripting.FileSystemObject")
If XXX.FolderExists(LuJin & "\临时导出账表") = False Then
   MkDir LuJin & "\临时导出账表"
End If
If VBA.Val(Application.Version) > 11 Then
   WBname = MM & "(" & DT & ")" & ".xlsx"
   If WorkbookOpen(WBname) = True Then
      MsgBox "【" & MM & "(" & DT & ") " & "】已经打开,请关闭后重新导出!", vbCritical, "系统警告"
      Exit Sub
   End If
Else
   WBname = MM & "(" & DT & ")" & "】.xls"
   If WorkbookOpen(WBname) = True Then
      MsgBox "【" & MM & "(" & DT & ") " & "】已经打开,请关闭后重新导出!", vbCritical, "系统警告"
      Exit Sub
   End If
End If
AAA = MsgBox("是否将当前内容导出到桌面【临时导出账表】?", 1 + 32 + 256, "系统提示")
If AAA = 2 Then Exit Sub
With Application
    .ScreenUpdating = False '关闭屏闪
    .DisplayAlerts = False '屏蔽错误提示信息
    .Workbooks.Add (1) '新一个工作薄默认添加一个工作表
     ActiveWindow.DisplayZeros = False '不显示零值
     If VBA.Val(Application.Version) > 11 Then '判断是否以2007以上版格式建档
       .ActiveWorkbook.SaveAs Filename:=LuJin & "\临时导出账表\" & MM & "(" & DT & ")" & ".xlsx"
     Else '判断是否以97-2003版格式建档
       .ActiveWorkbook.SaveAs Filename:=LuJin & "\临时导出账表\" & MM & "(" & DT & ")" & ".xls"
     End If
    .ThisWorkbook.Sheets(MM).Range("A1:" & Cells(R, 19).Address).Copy .ActiveSheet.Range("A1")
     Set Ws = .ActiveWorkbook.Sheets(1)
     Ws.Name = DT
     For Each Sh In Ws.Shapes '遍历当前工作表中所有Shape
         Sh.Delete '逐个删除
     Next
     Ws.PageSetup.PrintGridlines = True '打印网格线
     Ws.PageSetup.Orientation = xlLandscape '横向页面
     Ws.PageSetup.BlackAndWhite = True '单色打印
     Ws.PageSetup.CenterHorizontally = True '水平居中
     Ws.PageSetup.PrintTitleRows = "A3:A4" '打印顶端标题
     Ws.PageSetup.RightHeader = "&""宋体""&10" & "第 &P 页,共 &N 页     " '添加打印页码
    .ActiveWorkbook.Close True
    .DisplayAlerts = True
    .ScreenUpdating = True
End With
MsgBox "【" & MM & "(" & DT & ")" & "】" + vbCrLf + "------------------------------------------" + vbCrLf + "【温馨提示】 导 出 成 功!", vbInformation, "提示"
End Sub

请问出现的错误是我电脑或者OFFICE的问题还是这两段程序的问题?请大侠给我指点指点
非常感谢!
 楼主| 发表于 2017-8-11 17:07 | 显示全部楼层
上述问题有哪位高手亮一下剑吧,先谢谢啦!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2017-8-11 17:09 | 显示全部楼层
关键的问题是上述问题在有些机子没一点问题,但有些电脑上就出现了,无法理解!
回复 支持 反对

使用道具 举报

发表于 2017-8-12 12:04 | 显示全部楼层
不太懂,给你网上搜了一下

  1. 之前做了一个《备件管理系统》,基于Excel2007基础,后升级为Excel2013 64位系统,并对该软件进行我多次改版,但无故出现一个错误:每次打开就提示:“系统错误H8000FFFF(-2147418113)。灾难性故障”,按确定后出现“内存溢出”。在网上查阅大量资料均没有解决,该问题差不多困扰我近2年,今天在无意中给解决了。原因是在Sheet1工作表的VBE窗口中多了以下一句代码:Private Sub ShockwaveFlash1_OnReadyStateChange(ByVal newState As Long)End Sub
  2. 删除后问题解决,希望给遇到同样问题的朋友一个启示。
复制代码


回复 支持 反对

使用道具 举报

 楼主| 发表于 2017-8-13 17:23 | 显示全部楼层
frankzhang21 发表于 2017-8-12 12:04
不太懂,给你网上搜了一下

虽然问题没解决,但还是要非常感谢你!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2017-8-23 08:47 , Processed in 0.093600 second(s), 18 queries , Gzip On, Memcache On.

Powered by Discuz! X3.2

© 2001-2013 Comsenz Inc.

快速回复 返回顶部 返回列表