Excel在workbook.close之后崩溃

时间:2017-06-19 17:06:11

标签: excel vba excel-vba

我试过寻找其他线程(如下所示),但它对我没有帮助:

如果有人能帮助我,我将非常感激。

在关闭我的文件(包含代码)之前,我打开现有文本文件为.xls,将原始文件的内容粘贴到文本文件中,将此文件另存为.txt然后尝试关闭文件。

此时,excel崩溃" Excel停止工作"并尝试重新启动。

以下是代码:

Sub ClosingFile()

Dim racffim As String
Dim nometxt As String
Dim datatratada As String
Dim final As Integer
Dim nomeplant As String
Dim b As Integer
Dim wb As Workbook
Dim Demora As Long

racffim = Environ("UserName")

Application.EnableEvents = True
Set wb = Workbooks("MTT_" & racffim & ".xlsm")
wb.Activate
wb.Save
Application.Run "MTT_" & racffim & ".xlsm!Auto_Close"
wb.Close
Application.EnableEvents = False


ThisWorkbook.Activate
Range("A1").Select
Do While ActiveCell.Value <> ""
    If ActiveCell.Offset(0, 2) = "" Then
        ActiveCell.Offset(0, 2).Value = Now
        ActiveCell.Offset(0, 3).Value = ActiveCell.Offset(0, 2).Value -   ActiveCell.Offset(0, 1).Value
        ActiveCell.Offset(0, 5).Value = "Automatica Final"
    End If
    ActiveCell.Offset(1, 0).Select
Loop
Range("A1").Select

Application.DisplayAlerts = True

datatratada = Left(Date, 2) & Mid(Date, 4, 2) & Right(Date, 4)
nometxt = Left(ThisWorkbook.Path, Len(ThisWorkbook.Path) - 7) +      "Base_de_Arquivos" + "\" + racffim + "_" + datatratada
Application.DisplayAlerts = False

'Error is inside this IF
If Dir(nometxt & ".txt") <> vbNullString Then


ThisWorkbook.Activate
Sheets("bancodados").Range("A2:F2").Select
If ActiveCell.Offset(1, 0).Value <> "" Then
    Range(Selection, Selection.End(xlDown)).Select
End If
Selection.Copy

Workbooks.OpenText Filename:=nometxt & ".txt", Origin _
:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, Tab:=True, FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True

Set bkt = ActiveWorkbook

Range("A1").Select
If ActiveCell.Offset(1, 0).Value <> "" Then
    Selection.End(xlDown).Select
End If
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
bkt.SaveAs Filename:=nometxt, FileFormat:=xlText, CreateBackup:=False
bkt.Close False      '''''ERROR HERE''''
Set bkt = Nothing
''''''''''''''''''''''''''''''''''''''''''''''''''''''


Else
    ActiveWorkbook.SaveAs Filename:=nometxt, FileFormat:=xlText,  CreateBackup:=False
End If


MsgBox ("Marcações Salvas")

Application.IgnoreRemoteRequests = False


    Application.DisplayAlerts = True
    ThisWorkbook.Saved = True
    If Workbooks.Count > 1 Then
        ThisWorkbook.Close False
    Else
        Application.Quit
    End If
End sub

请原谅葡萄牙语的评论,但他们不应该向您提供任何有用的信息。

另外我应该提一下这个Sub用这段代码调用:

   Sub SleepAfter()


    If UserForm1.CheckBox1 = True Then

        horario = UserForm1.ComboBox1.Value
        harr = TimeValue(horario)
        hnow = TimeValue(Time)

        If harr < hnow Then

            Call encerramento

        End If

    End If

End Sub

0 个答案:

没有答案