Доброго дня, можете подсказать что делаю не так? Зависает при сохранении, а после вылетает все
| Код |
|---|
Private Sub AOSR2()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlManual
Application.EnableEvents = False
Dim S As String
S = Sheets("АОСР").Range("W32")
Dim w As String
w = Range("V32").Value
Dim TitleName As String
Dim UserName As String
Dim ActName As String
Dim DirName As String
Dim Object As String
Dim FileN As String
Dim FileN2 As String
Dim x As String
Dim R As String
Dim wb As Workbook
Set wb = Workbooks.Add
Dim TWB As Workbook
Set TWB = ThisWorkbook
TitleName = Replace(ThisWorkbook.Sheets("данные").Cells(21, "B").Value, "/", "_")
UserName = Replace(ThisWorkbook.Sheets("данные").Cells(20, "B").Value, "/", "_")
ActName = Replace(ThisWorkbook.Sheets("данные").Cells(22, "B").Value, "/", "_")
Object = Replace(ThisWorkbook.Sheets("данные").Cells(26, "B").Value, "/", "_")
DirName = "O:\1. Сопровождение Исполнительной документации\" & Object & "\"
If Not CreateObject("Scripting.FileSystemObject").FolderExists(DirName) Then MkDir (DirName)
If Not CreateObject("Scripting.FileSystemObject").FolderExists(DirName & UserName & "\") Then MkDir (DirName & UserName)
If Not CreateObject("Scripting.FileSystemObject").FolderExists(DirName & UserName & "\" & TitleName & "\") Then MkDir (DirName & UserName & "\" & TitleName)
If S = "Да" Then
If Not CreateObject("Scripting.FileSystemObject").FolderExists(DirName & UserName & "\" & TitleName & "\" & "АОСР - " & ActName & "\") Then MkDir (DirName & UserName & "\" & TitleName & "\" & "АОСР - " & ActName)
FileN = DirName & UserName & "\" & TitleName & "\" & "АОСР - " & ActName & "\" & ActName & ".xlsb"
Else:
FileN2 = DirName & UserName & "\" & TitleName & "\" & "АОСР - " & ActName & ".xlsb"
End If
Application.Calculation = xlManual
Application.CalculateBeforeSave = False
Windows(ThisWorkbook).Activate
If S = "Да" Then
ActiveWorkbook.SaveAs FileN, FileFormat:=50
Else:
ActiveWorkbook.SaveAs FileN2, FileFormat:=50
End If
ThisWorkbook.Sheets("АОСР").Copy Before:=wb.Sheets(1)
[AE7:AI8].Value2 = [AE7:AI8].Value2
[BL1:BL45].Value2 = [BL1:BL45].Value2
[BB1:BB200].Value2 = [BB1:BB200].Value2
ActiveWorkbook.Save
wb.Close True
Windows("АОСР v 7.00 центральная.xlsm").Activate
For y = 1 To Cells.SpecialCells(xlLastCell).Row
If Cells(y, 64) = w Then
Exit For
End If
Next y
Windows("АОСР v 7.00 центральная.xlsm").Activate
Worksheets("АОСР").Range("BB31") = CStr(y + 1)
x = Worksheets("Лист1").Range("$N2").Offset(y)
Worksheets("АОСР").Range("V32") = x
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub |
