请教系统错误&H8000FFFF灾难性故障

myexcel2013

大侠:
我的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的问题还是这两段程序的问题?请大侠给我指点指点
非常感谢!

myexcel2013

上述问题有哪位高手亮一下剑吧,先谢谢啦!

myexcel2013

关键的问题是上述问题在有些机子没一点问题,但有些电脑上就出现了,无法理解!

frankzhang21

不太懂，给你网上搜了一下

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

复制代码

myexcel2013

frankzhang21 发表于 2017-8-12 12:04
不太懂，给你网上搜了一下

虽然问题没解决,但还是要非常感谢你!