Excel ошибка сохранения макрос

Цитата
Sanja написал:
Версия Excel? И разрядность. И файл-пример

Версия Эксель  2007 г.

Проц 32-х разрядный. А сам эксель тоже для 32.

Насколько помню, если не ошибаюсь, 64 разрядная версия на 32 разрядную систему и не установиться.

Так что, с этим все нормально.

Что касается файла примера, дело в том, что файлов много. Есть с большим вложением макросов, есть с меньшим. Но толку с того, если прикреплю файл пример?

Дело в том, что эксель при любом файле с макросами вылетает.

Правда происходит это не всегда при сохранении. Только иногда. Ну, примерно в час один раз.

Но когда происходит, без мата не обхожусь. Потому, что так она достала уже … эта мерзо-пакость. В особенности, когда сижу уткнувшись в монитор и все внимание на алгоритмы, и отладку кода. И в этом самое время вдруг внезапно бац … и выходит сообщение о сбое работы Эксель.

И главное так не только на одном компьютере, но и на всех остальных. Аж в пяти местах проверял. И в win’7/8 и даже в winXP. ВЕЗДЕ так делает зараза. И никак не угомониться.

Цитата
Игорь написал: Тут либо проблема в макросах, либо проблема из-за сбоя в файле Excel

Так что, сам файл навряд ли имеет кряк. Потому, что все файлы, которые заново создавались, в которых макросы писались с нуля, ведь не могут быть битыми.

И при этом, что касается того, если сами  макросы вызывают вылет Excel…. Тоже не думаю, что так.

Потому, что и тут, файлов много… и при работе с любым из них, Эксель всегда выкидывает такие номера.

И при этом, дело в том, что я те же самые макросы перенес в файл надстройки. С тем же самым кодом. Сам код макросов и в файле *.XLAM был тот же что в *.xlsm. Но почему то, в работе с первым ни один раз не было такой кляузы, а со вторым иногда даже каждый пол часа.

Так что, ну просто понять не могу в чем причина… и главное это чаще происходит, когда редактор VBA разработчик открыт.

Может быть, дело в подключенных библиотеках, которые стали не по вкусу, Excel-ю 2007?

Но и тут могу сказать, что в этом не сильно большой прихотливостью отличался. И в опции: References не тонную величину библиотек подключил. А всего каких то два или три дополнительных.

Вот все библиотеки которые подключены:

Visual Basic for Application

Microsoft Excel 12.0 Object Library

Microsoft Office 12.0 Object Library

Microsoft Forms 2.0 Object Library

Microsoft ActiveX Data Object 2.8 Library

Вот и все подключенные библиотеки.

Так что, я просто понять не могу, причину.

Мало того, что когда занимаешься отладкой макроса, столько проблем возникает, и работаешь над  устранением ошибок в коде приложения. И с трудом, но в итоги добиваешься корректной работой кода. И это вроде бы удается. И думаешь, ну все ….  теперь все работает нормально. И сложные алгоритмы корректно составлены, и  переменные нигде не конфликтуют. И наконец вздыхаешь с облегчением. И тут на тебе…. Что уже навряд ли ошибки того, что ты написал, а скорее думаю недоработки самой среды разработки. И самого производителя. И думаешь, как раз еще этого не хватало. Что бы, еще отвечать, не только за свои приложения, но еще и за среду.

Так что, опять рассчитываю на помощь!

И опять буду признателен за ответ!

Добрый день!!! Что то случилось. Перестали работать все макросы в excel,все они были выведены на панель быстрого допуска.Сейчас в книгах макросов нет ни одного макроса,куда они подевались? Сейчас макрос записывается и работает,но при выходе из Excel он перестает работать и книга макросов снова пуста.Раньше после записи макроса и выхода из Excel запрашивалось потверждение о сохранении макроса для его дальнейшей работы сейчас нет. Помогите разобрать с этой ситуацией.   

Sub vib_krasnodar()

‘ Макрос4 Макрос


    Columns(«A:A»).Select
    Selection.TextToColumns Destination:=Range(«A1»), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1)), TrailingMinusNumbers:=True
End Sub

Проблемы

При запуске макроса Visual Basic для приложений в Microsoft Excel может появиться следующее или аналогичное сообщение об ошибке:

Ошибка при запуске ‘1004’:
Метод ‘SaveAs’ объекта ‘_Worksheet’ не удалось

Причина

Такое поведение может происходить, если оба условия истинны:

  • Для сохранения Visual Basic для приложений используется макрос.

    -and-

  • Формат файла указывается как постоянная xlWorkbookNormal.

Например, эта ошибка возникает по следующему коду:

Sub A()
Dim myNewSheet As Worksheet
Set myNewSheet = ActiveSheet
FileNameBin = "c:ABC"
myNewSheet.SaveAs Filename:=FileNameBin, FileFormat:=xlWorkbookNormal
End Sub

Обходное решение

Корпорация Майкрософт предлагает примеры программного кода только для иллюстрации и не предоставляет явных или подразумеваемых гарантий относительно их корректной работы в конкретных случаях и в пользовательских приложениях. Примеры в данной статье рассчитаны на пользователя, имеющего достаточный уровень знаний соответствующего языка программирования, а также необходимых средств разработки и отладки. Специалисты служб технической поддержки Майкрософт могут пояснить назначение тех или иных конструкций кода в конкретном примере, но модификация примеров и их адаптация к задачам разработчика не поддерживается.
Если у вас ограниченный опыт программирования, обратитесь к сертифицированным партнерам Майкрософт или в службы microsoft Advisory Services. Дополнительные сведения можно найти на следующих веб-сайтах Майкрософт:

сертифицированные партнеры Майкрософт — https://partner.microsoft.com/global/30000104

Microsoft Advisory Services — http://support.microsoft.com/gp/advisoryservice

Дополнительные сведения о доступных вариантах поддержки и о том, как связаться с корпорацией Майкрософт, можно найти на следующем веб-сайте Майкрософт:http://support.microsoft.com/default.aspx?scid=fh;EN-US;CNTACTMS

Чтобы обойти эту ситуацию, измените спецификацию формата файла с константы xlWorkbookNormal на 1. Функции кода в примере обычно выполняются в том случае, если он был изменен на:

Sub A()
Dim myNewSheet As Worksheet
Set myNewSheet = ActiveSheet
FileNameBin = "c:ABC"
myNewSheet.SaveAs Filename:=FileNameBin, FileFormat:=1
End Sub

ПРИМЕЧАНИЕ. Несмотря на сохранение книги, все его книги сохраняются при выборе формата xlWorkbookNormal или 1.

Статус

Корпорация Майкрософт подтверждает, что это проблема в продуктах Майкрософт, перечисленных в начале этой статьи.

Нужна дополнительная помощь?

NikolayHAOS

-3 / 2 / 0

Регистрация: 29.10.2013

Сообщений: 178

1

После выполнения макроса, сохранение книги — ошибка

06.10.2017, 08:42. Показов 3219. Ответов 17

Метки нет (Все метки)


Студворк — интернет-сервис помощи студентам

Всем доброго времени суток.
Есть пара макросов в личной книге макросов.
Первый.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
Sub Подготовка_Микро_уч()
'
' Подготовка_Микро_уч Макрос
'
    Sheets("Приложение № 7 ").Select
    ActiveSheet.Unprotect
    Sheets("Приложение № 3 ").Select
    ActiveSheet.Unprotect
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Sheets("Приложение № 7 ").Select
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Application.DisplayAlerts = False
    Sheets("Техническая часть").Delete
    Sheets("Вводные").Visible = -1
    Sheets("Вводные").Delete
    Sheets("WARNING").Visible = -1
    Sheets("WARNING").Delete
    Application.DisplayAlerts = True
    Sheets("Титульный").Select
    Range("A1").Select
    Sheets("Микроучасток").Select
    Range("Таблица1[[#Headers],[№ п.п]]").Select
    ActiveWindow.Zoom = 100
    Dim Sh As Worksheet
    Dim iObj As ListObject
    For Each Sh In Worksheets
    For Each iObj In Sh.ListObjects
        iObj.Unlist
    Next
    Next
    Dim oVBComponent As Object, lCountLines As Long
    Set oVBComponent = ActiveWorkbook.VBProject.VBComponents("ЭтаКнига")
    With oVBComponent
        lCountLines = .CodeModule.CountOfLines
        .CodeModule.DeleteLines 1, lCountLines
    End With
    Set oVBComponent = Nothing
    Dim n As Variant
    For Each n In ActiveWorkbook.Names:
    On Error Resume Next
    n.Delete:
    Next
'Call Macro2
End Sub

Второй.

Visual Basic
1
2
3
4
5
6
7
8
Sub Macro2()
   ChDir "D:UsersuserDesktopНовая папка"
    ActiveWorkbook.SaveAs FileName:= _
        "D:UsersuserDesktopНовая папка" & ActiveWorkbook.Name & ".xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        Application.DisplayAlerts = False
        Application.Quit       
End Sub

По отдельности (по горячим клавишам) отрабатывают оба нормально.
А если прописать выполнение второго в первом, то выскакивает ошибка.

После выполнения макроса, сохранение книги - ошибка



0



es geht mir gut

11264 / 4746 / 1183

Регистрация: 27.07.2011

Сообщений: 11,437

06.10.2017, 08:49

2

Цитата
Сообщение от NikolayHAOS
Посмотреть сообщение

«.xlsx»

xlsm попробуйте.

Добавлено через 1 минуту

Цитата
Сообщение от NikolayHAOS
Посмотреть сообщение

ActiveWorkbook.Name

Если уверены что активна нужная книга.



0



6875 / 2807 / 533

Регистрация: 19.10.2012

Сообщений: 8,562

06.10.2017, 09:23

3

Если хотите сохранять как xlsx — нет нужды предварительно возиться с удалением макросов, тем более что это требует доступа к проектам.



0



-3 / 2 / 0

Регистрация: 29.10.2013

Сообщений: 178

06.10.2017, 11:26

 [ТС]

4

SoftIce,
Уверен, что активна нужная книга.
Hugo121, дык все равно выскакивает предупреждение, как его побороть?



0



es geht mir gut

11264 / 4746 / 1183

Регистрация: 27.07.2011

Сообщений: 11,437

06.10.2017, 11:33

5

Лучший ответ Сообщение было отмечено NikolayHAOS как решение

Решение

В xlsm тоже не сохраняется ?

Добавлено через 48 секунд
Или Вам просто предупреждение мешает?

Добавлено через 3 минуты

Цитата
Сообщение от NikolayHAOS
Посмотреть сообщение

выскакивает предупреждение, как его побороть?

Application.DisplayAlerts = False попробуйте перенести выше.



1



NikolayHAOS

-3 / 2 / 0

Регистрация: 29.10.2013

Сообщений: 178

06.10.2017, 11:45

 [ТС]

6

Цитата
Сообщение от SoftIce
Посмотреть сообщение

В xlsm тоже не сохраняется ?

Да… вообще не сохраняет.
Если макрос вот такой то вообще никакого сохранения по указанному пути не происходит.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
Sub Подготовка_Микро_уч()
'
' Подготовка_Микро_уч Макрос
'
 
'
    Sheets("Приложение № 7 ").Select
    ActiveSheet.Unprotect
    Sheets("Приложение № 3 ").Select
    ActiveSheet.Unprotect
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Sheets("Приложение № 7 ").Select
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Application.DisplayAlerts = False
    Sheets("Техническая часть").Delete
    Sheets("Вводные").Visible = -1
    Sheets("Вводные").Delete
    Sheets("WARNING").Visible = -1
    Sheets("WARNING").Delete
    Application.DisplayAlerts = True
    Sheets("Титульный").Select
    Range("A1").Select
    Sheets("Микроучасток").Select
    Range("Таблица1[[#Headers],[№ п.п]]").Select
    ActiveWindow.Zoom = 100
    Dim Sh As Worksheet
    Dim iObj As ListObject
    For Each Sh In Worksheets
    For Each iObj In Sh.ListObjects
        iObj.Unlist
    Next
    Next
    Dim oVBComponent As Object, lCountLines As Long
        Set oVBComponent = ActiveWorkbook.VBProject.VBComponents("ЭтаКнига")
        With oVBComponent
            lCountLines = .CodeModule.CountOfLines
            .CodeModule.DeleteLines 1, lCountLines
        End With
        Set oVBComponent = Nothing
        Dim n As Variant
       For Each n In ActiveWorkbook.Names:
    On Error Resume Next
    n.Delete:
    Next
     ChDir "D:UsersNikolayHAOSDesktopНовая папка"
    ActiveWorkbook.SaveAs FileName:= _
        "D:UsersNikolayHAOSDesktopНовая папка" & ActiveWorkbook.Name & ".xlsm" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
       
 
End Sub

Ща попробую.

Добавлено через 2 минуты
Урааа.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
Sub Подготовка_Микро_уч()
'
' Подготовка_Микро_уч Макрос
 
    Sheets("Приложение № 7 ").Select
    ActiveSheet.Unprotect
    Sheets("Приложение № 3 ").Select
    ActiveSheet.Unprotect
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Sheets("Приложение № 7 ").Select
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Application.DisplayAlerts = False
    Sheets("Техническая часть").Delete
    Sheets("Вводные").Visible = -1
    Sheets("Вводные").Delete
    Sheets("WARNING").Visible = -1
    Sheets("WARNING").Delete
    Application.DisplayAlerts = True
    Sheets("Титульный").Select
    Range("A1").Select
    Sheets("Микроучасток").Select
    Range("Таблица1[[#Headers],[№ п.п]]").Select
    ActiveWindow.Zoom = 100
    Dim Sh As Worksheet
    Dim iObj As ListObject
    For Each Sh In Worksheets
    For Each iObj In Sh.ListObjects
        iObj.Unlist
    Next
    Next
    Dim oVBComponent As Object, lCountLines As Long
        Set oVBComponent = ActiveWorkbook.VBProject.VBComponents("ЭтаКнига")
        With oVBComponent
            lCountLines = .CodeModule.CountOfLines
            .CodeModule.DeleteLines 1, lCountLines
        End With
        Set oVBComponent = Nothing
        Dim n As Variant
       For Each n In ActiveWorkbook.Names:
    On Error Resume Next
    n.Delete:
    Next
    Application.DisplayAlerts = False
         ChDir "D:UsersNikolayHAOSDesktopНовая папка"
    ActiveWorkbook.SaveAs FileName:= _
        "D:UsersNikolayHAOSDesktopНовая папка" & ActiveWorkbook.Name & ".xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        Application.Quit
End Sub

Отработал так как надо.
Спасибо.

Добавлено через 4 минуты
Вот хрень перестал работать, все указанное в макросе выполняет, а сохранения не происходит как и закрытия документа.
То есть выходит что вот этот участок не выполняется почему-то.

Visual Basic
1
2
3
4
5
6
Application.DisplayAlerts = False
         ChDir "D:UsersNikolayHAOSDesktopНовая папка"
    ActiveWorkbook.SaveAs FileName:= _
        "D:UsersNikolayHAOSDesktopНовая папка" & ActiveWorkbook.Name & ".xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        Application.Quit



0



Эксперт WindowsАвтор FAQ

17991 / 7617 / 890

Регистрация: 25.12.2011

Сообщений: 11,351

Записей в блоге: 17

07.10.2017, 15:13

7

Цитата
Сообщение от NikolayHAOS
Посмотреть сообщение

«D:UsersNikolayHAOSDesktopНовая папка» & ActiveWorkbook.Name & «.xlsx«

Вам же выше написали, что нужен формат xlsm

И формат нужен не xlOpenXMLWorkbook, а xlOpenXMLWorkbookMacroEnabled (скорее всего, я не проверял). См. https://msdn.microsoft.com/en-… tion-excel



0



NikolayHAOS

-3 / 2 / 0

Регистрация: 29.10.2013

Сообщений: 178

07.10.2017, 17:43

 [ТС]

8

Цитата
Сообщение от Dragokas
Посмотреть сообщение

Вам же выше написали, что нужен формат xlsm

НО мне то нужно сохранить без макросов в .xlsx

Добавлено через 35 минут
УРА….
Разобрался все заработало.
Глупая ошибка прошу у всех прощения. У двух разных макросов одна и та же комбинация клавиш была.
Вот код который работает на ура.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
Sub Подготовка_Микро_уч()
'
' Подготовка_Микро_уч Макрос
'
 
'
    Sheets("Приложение № 7 ").Select
    ActiveSheet.Unprotect
    Sheets("Приложение № 3 ").Select
    ActiveSheet.Unprotect
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Sheets("Приложение № 7 ").Select
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Application.DisplayAlerts = False
    Sheets("Техническая часть").Delete
    Sheets("Вводные").Visible = -1
    Sheets("Вводные").Delete
    Sheets("WARNING").Visible = -1
    Sheets("WARNING").Delete
    Application.DisplayAlerts = True
    Sheets("Титульный").Select
    Range("A1").Select
    Sheets("Микроучасток").Select
    Range("Таблица1[[#Headers],[№ п.п]]").Select
    ActiveWindow.Zoom = 100
    Dim sh As Worksheet
    Dim iObj As ListObject
    For Each sh In Worksheets
    For Each iObj In sh.ListObjects
        iObj.Unlist
    Next
    Next
    Dim oVBComponent As Object, lCountLines As Long
        Set oVBComponent = ActiveWorkbook.VBProject.VBComponents("ЭтаКнига")
        With oVBComponent
            lCountLines = .CodeModule.CountOfLines
            .CodeModule.DeleteLines 1, lCountLines
        End With
        Set oVBComponent = Nothing
        Dim n As Variant
       For Each n In ActiveWorkbook.Names:
    On Error Resume Next
    n.Delete:
    Next
    Application.DisplayAlerts = False
     ChDir "D:UsersNikolayHAOSDesktopНовая папка"
    ActiveWorkbook.SaveAs FileName:= _
        "D:UsersNikolayHAOSDesktopНовая папка" & ActiveWorkbook.Name & ".xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        Application.Quit
 
End Sub



0



6875 / 2807 / 533

Регистрация: 19.10.2012

Сообщений: 8,562

07.10.2017, 23:17

9

Так в чём смысл строк 41-47?



0



-3 / 2 / 0

Регистрация: 29.10.2013

Сообщений: 178

08.10.2017, 08:23

 [ТС]

10

Hugo121, Вы сами знаете что делают эти строки. :-)
Вот файл для которого применяется данный макрос.
пример.zip
Если удалить указанные вами строки, будет выскакивать ошибка при сохранении книги.
Если сможете предложить другой способ, буду премного благодарен.



0



NikolayHAOS

-3 / 2 / 0

Регистрация: 29.10.2013

Сообщений: 178

08.10.2017, 09:52

 [ТС]

11

Всем доброго времени суток.
Еще раз всем помогавшим спасибо.
Вот как стал выглядеть код в итоге.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
Sub кол_вх()
Dim s As String, fldr As String
fldr = "D:111"
s = Dir(fldr & "*.xls")
Do While s <> ""
    With Workbooks.Open(fldr & s)
        Dim oVBComponent As Object, lCountLines As Long
        Set oVBComponent = ActiveWorkbook.VBProject.VBComponents("ЭтаКнига")
        With oVBComponent
            lCountLines = .CodeModule.CountOfLines
            .CodeModule.DeleteLines 1, lCountLines
        End With
        Set oVBComponent = Nothing
        Sheets("Приложение № 7 ").Select
        ActiveSheet.Unprotect
        Cells.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("A1").Select
        Sheets("Приложение № 3 ").Select
        ActiveSheet.Unprotect
        Cells.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("A1").Select
        Sheets("Титульный").Select
        Range("A1").Select
        Sheets("Микроучасток").Select
        Range("Таблица1[[#Headers],[№ п.п]]").Select
        ActiveWindow.Zoom = 100
        Dim sh1 As Worksheet
        Dim iObj As ListObject
        For Each sh1 In Worksheets
        For Each iObj In sh1.ListObjects
            iObj.Unlist
        Next
        Next
        Dim sfName1$
        Dim sh As Worksheet, nm As Name
        sfName1 = ActiveWorkbook.FullName
        sfName1 = Replace(sfName1, "xlsm", "xlsx")
        sfName2 = Left(sfName1, Len(sfName1) - 1)
        Application.ScreenUpdating = False
        Application.CopyObjectsWithCells = False
        ActiveWorkbook.Sheets(Array(1, 2, 3, 5)).Copy
        For Each sh In ActiveWorkbook.Worksheets
            sh.UsedRange.Value = sh.UsedRange.Value
        Next
         For Each n In ActiveWorkbook.Names:
        On Error Resume Next
        n.Delete:
        Next
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs sfName1, 51
        ActiveWorkbook.Close False
        Application.DisplayAlerts = True
        Application.CopyObjectsWithCells = True
    .Close 0
    End With
    s = Dir
Loop
End Sub



0



6875 / 2807 / 533

Регистрация: 19.10.2012

Сообщений: 8,562

08.10.2017, 12:34

12

Я не спрашивал что делают, я спрашивал в чём смысл?
В новом варианте допустим даже в вроде бесполезных строках 27-29 можно найти смысл при определённых требованиях, но вот зачем удалять в книге проект, если затем эти изменения не сохраняются, или зачем затем возможно (отсюда не видно) по два раза (но если по разу — то тоже зачем первый?) заменять формулы на значения?



0



NikolayHAOS

-3 / 2 / 0

Регистрация: 29.10.2013

Сообщений: 178

08.10.2017, 12:48

 [ТС]

13

Ой блин не успел поправить код в сообщении.
Вот как в итоге стал выглядеть файл.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
Sub Микро_на_сдачу()
    Dim sFolder As String, sFiles As String
    'диалог запроса выбора папки с файлами
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    With UserForm1
        .Show 0
        .Label1.Caption = "Работаем..."
        .Repaint
        For i = 1 To 100000000
        Next
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    'отключаем обновление экрана, чтобы наши действия не мелькали
    Application.ScreenUpdating = False
    sFiles = Dir(sFolder & "*№*.xlsm")
    Do While sFiles <> ""
        'открываем книгу
        Workbooks.Open sFolder & sFiles
        'действия с файлом
        Sheets("Приложение № 7 ").Select
        ActiveSheet.Unprotect 'снимаем блокировку с листа
        Cells.Select 'выделяем весь лист
        Selection.Copy 'Копируем
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False ' вставляем в лист значения за место формул
        Range("A1").Select
        Sheets("Приложение № 3 ").Select
        ActiveSheet.Unprotect
        Cells.Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("A1").Select
        Sheets("Титульный").Select
        Range("A1").Select
        Sheets("Микроучасток").Select
        Range("Таблица1[[#Headers],[№ п.п]]").Select
        ActiveWindow.Zoom = 100
        'Преорбазуем таблицы в диапазоны
        Dim sh1 As Worksheet
        Dim iObj As ListObject
        For Each sh1 In Worksheets
        For Each iObj In sh1.ListObjects
            iObj.Unlist
        Next
        Next
        'Макрос сохранения книги со старым именем и новым расширением xlsx
        Dim sfName1$
        Dim sh As Worksheet, nm As Name
        sfName1 = ActiveWorkbook.FullName
        sfName1 = Replace(sfName1, "xlsm", "xlsx")
        Application.ScreenUpdating = False
        Application.CopyObjectsWithCells = False
        ActiveWorkbook.Sheets(Array(1, 2, 3, 5)).Copy
        'Преобразование формул в значения, не всегда работает корректно, оставил просто так.
        For Each sh In ActiveWorkbook.Worksheets
            sh.UsedRange.Value = sh.UsedRange.Value
        Next
        'Удаление именнованных диапазонов показать по ctrl+F3
         For Each n In ActiveWorkbook.Names:
        On Error Resume Next
        n.Delete:
        Next
        
        Application.DisplayAlerts = False
        ActiveWorkbook.SaveAs sfName1, 51
        ActiveWorkbook.Close False
        Application.DisplayAlerts = True
        Application.CopyObjectsWithCells = True
    
        'Закрываем книгу с сохранением изменений
        ActiveWorkbook.Close False 'если поставить False - книга будет закрыта без сохранения
        sFiles = Dir
    Loop
    'возвращаем ранее отключенное обновление экрана
    Application.ScreenUpdating = True
    .Label1.Caption = "ГОТОВО"
    End With
End Sub

Hugo121, ранее использовался другой способ сохранения файла и наличие в разделе ЭтаКнига кода макроса приводило к остановке макроса и ошибке. В новом варианте этот рудимент удалён.
Выделение ячеек нужно для возврата фокуса при последующем открытии файла в начало. (у меня сложилось впечатление что excel запоминает где была последняя активная ячейка)
К сожалению код

Visual Basic
1
2
3
For Each sh In ActiveWorkbook.Worksheets
            sh.UsedRange.Value = sh.UsedRange.Value
        Next

Не корректно отрабатывает, сохраняя битые ссылки. Можно в этом убедится на примере выше в сообщении выше.



0



6875 / 2807 / 533

Регистрация: 19.10.2012

Сообщений: 8,562

08.10.2017, 13:08

14

В

Цитата
Сообщение от NikolayHAOS
Посмотреть сообщение

примере выше в сообщении выше

нет примера, а если брать тот что выше выше выше… — там нет макроса.
А тот макрос, что есть в теме — не работает ибо нет у меня таких файлов.
Тупик…



0



-3 / 2 / 0

Регистрация: 29.10.2013

Сообщений: 178

08.10.2017, 13:13

 [ТС]

15

Вот файл с макросом и примером.
Вложение 870930
Я закомментировал строки о копировании и вставки значений.



0



6875 / 2807 / 533

Регистрация: 19.10.2012

Сообщений: 8,562

08.10.2017, 13:42

16

Ну так и вот, всё работает ведь без этих лишних телодвижений
Правда появляется #REF из-за того, что нет источника данных для формул — ну тогда действительно чтоб глубоко не рыть есть смысл сперва всё заменить в источнике, но тогда нет смысла снова менять в уже изменённых скопированных листах.
И можно там по мелочи оптимизнуть — например вынести из цикла On Error Resume Next



0



NikolayHAOS

-3 / 2 / 0

Регистрация: 29.10.2013

Сообщений: 178

08.10.2017, 14:52

 [ТС]

17

Цитата
Сообщение от Hugo121
Посмотреть сообщение

например вынести из цикла On Error Resume Next

Так?

Visual Basic
1
2
3
4
5
'Удаление именнованных диапазонов показать по ctrl+F3
 On Error Resume Next
   For Each n In ActiveWorkbook.Names:       
   n.Delete:
   Next



0



6875 / 2807 / 533

Регистрация: 19.10.2012

Сообщений: 8,562

08.10.2017, 14:54

18

Ну да, зачем зазря тратить системные ресурсы



0



Не работают макросы в Excel? Включите их выполнение, добавьте специальный модель с кодом, проверьте версию ОС и Эксель, убедитесь в соответствии пакета приложений, активируйте Майкрософт Офис, снимите блокировку файла, проверьте систему безопасности и применяемые библиотеки. Ниже подробно рассмотрим, в чем могут быть причины подобной неисправности, и какие шаги предпринимать для ее устранения.

Причины

Для начала стоит разобраться, почему не работает макрос в Excel, ведь от этого зависят дальнейшие шаги. К основным причинам стоит отнести:

  1. Функция отключена.
  2. Отключение отслеживания событий.
  3. Устаревшая операционная система.
  4. Несоответствие разработчика пакета офисных приложений.
  5. Устаревшая версия Майкрософт Офис.
  6. Неактивированная версия Excel.
  7. Заблокированный файл.
  8. Неправильные настройки безопасности.
  9. Отсутствие необходимой библиотеки и т. д.

Выше рассмотрены основные причины, почему не удается выполнить макрос в Excel. Все они могут быть решены самостоятельно с помощью приведенных ниже рекомендации. Подробнее на решении вопроса остановимся ниже.

Что делать

Многие пользователи теряются в ситуации, когда не включаются или вообще не работают макросы в Excel. Такая проблема не дает нормально пользоваться приложением и заставляет искать альтернативные варианты.

Включите опцию

Первое, что необходимо сделать — включить функцию для обеспечения ее работоспособности. Здесь многое зависит от версии Эксель.

Если не работают макросы в Excel 2003, сделайте следующие шаги:

  1. Войдите в «Сервис».
  2. Перейдите в раздел «Безопасность».
  3. Кликните «Уровень макросов «Низкий».

В случае, когда не работают макросы в Excel 2007, включите их следующим образом:

  1. Жмите на кнопку «Офис».
  2. Войдите в параметры Excel.
  3. Кликните на «Центр управления безопасности».
  4. Войдите в «Параметры центра управления безопасностью».
  5. Жмите на «Параметры макросов».
  6. Кликните на «Разрешить все …».

В ситуации, когда не работают макросы в Excel 2016, сделайте следующие шаги:

  1. Войдите в раздел «Файл».
  2. Кликните на кнопку «Параметры».
  3. Зайдите в «Центр управления безопасностью».
  4. Войдите в «Параметры центра управления безопасностью».
  5. Кликните на «Параметры …».
  6. Жмите на «Разрешить все …».

После внесения изменений параметра безопасности перезапустите приложение Excel, а именно закройте его полностью и откройте снова. Лишь после этого изменения вступают в силу.

Добавьте нужный модуль в книгу

Бывают ситуации, когда макросы включены, но не работают в Excel из-за отключения каким-либо элементом отслеживания событий. В таком случае сделайте следующее:

  1. Перейдите в редактор VBA с помощью клавиш Alt+F11.
  2. Вставьте указанный ниже код.

Sub Reset_Events()

Application.EnableEvents = True

End Sub

  1. Для выполнения кода поставьте курсор в любой точке между началом и концом.
  2. Кликните F5.

Проверьте операционную систему

В ситуации, когда не отображаются макросы в Excel, обратите внимание на тип операционной системы. К примеру, Майкрософт Офис, который подходит для Виндовс, на Мак ОС уже работать не будет. Причина в том, что в приложении используются разные библиотеки. Даже если надстройки и функционируют, могут быть сбои в работе. Вот почему при появлении проблем нужно проверить ОС на соответствие.

Обратите внимание на разработчика

Если в Экселе не работают макросы, причиной может быть другой разработчик. Так, пользователи Excel часто применяют OpenOffice или LibreOffice. Эти пакеты созданы на разных языках программирования, которые имеют индивидуальные особенности. Так, если надстройки написаны на Visual Basic for Application, он может не работать в указанных выше офисных приложениях. Вот почему необходимо уточнять, для какого пакета создан макрос / надстройка.

Проверьте версию Майкрософт Офис

В Макрософт Офис 2003 применяются надстройки xla для Excel. В современных версиях расширение поменялось на xlam. Если ставить макросы старого типа в приложения Офис 2007 и больше, никаких трудностей не происходит. Если же вы попытаетесь поставить новую надстройку на старую версию Excel, она зачастую не работает. Вот почему важно обратить внимание на этот параметр при выборе.

Убедитесь в наличии пакета VBA

Одной из причин, почему не запускается макрос в Excel, может быть отсутствие пакета VBA. Для успешного запуска надстройки необходимо, чтобы этот пакет был установлен. Иногда он уже установлен в Офис, но так происходит не всегда. Для проверки жмите комбинацию на Alt+F11. Если после этого появляется Visual Basic, компонент можно считать установленным. В ином случае его нужно поставить. Для этого:

  • Зайдите в «Пуск», а далее «Панель управления / Программы и компоненты».

  • Выберите программу Майкрософт Офис.
  • Жмите на кнопку «Изменить».

  • Запустить файл установки Setup.exe.
  • Кликните на «Добавить или удалить компоненты».
  • Выберите в списке Visual Basic и установите его.

Активируйте Офис

Если в Excel 2007 не работает кнопка «макросы», причиной может быть отсутствие активации приложения. Для этого жмите на кнопку «Активировать» и следуйте инструкции. В большинстве случаев такая опция является платной.

Снимите блокировку файла

Учтите, что документ, полученный с другого ПК / ноутбука, может заблокироваться. Для разблокировки файла нужно нажать ПКМ и в разделе «Общие» кликнуть на «Разблокировать».

 Проверьте библиотеки

В случае, когда параметры макросов не активны в Excel, причиной может быть появление ошибки «Can’t find project or library». При этом, надстройка работает на другом ПК / ноутбуке, а здесь возникают проблемы. Ошибку легко устранить, если в окне, которое идет за сообщением об ошибке, снять отметки в полях Missing. Для вызова окна можно выбрать пункт меню Tools / References.

Проверьте настройки безопасности

В ситуации, когда не работают макросы в Excel, можно добавить надежные расположения или настроить доступ к объектной модели VBA. Для этого в Офис 2007 необходимо сделать следующее:

  1. Войдите в Меню
  2. Кликните на пункт «Параметры».
  3. Жмите на «Центр управления безопасностью».
  4. Войдите в «Параметры центра управления безопасностью».
  5. Кликните на «Параметры макросов» и «Доверять доступ к объектной модели проектов».

Зная, почему не работают макросы в Excel, вы можете с легкостью исправить проблему и восстановить работоспособность. Если же сложности в работе возникают, вы всегда можете воспользоваться инструкцией в статье.

В комментариях расскажите, какой из приведенных выше вариантов вам помог, и что еще можно сделать.

Отличного Вам дня!

при попытке сохранения файла Excel с поддержкой макросов загорается окно «Обнаружены ошибки при сохранении «путь файла». Возможно, приложению Microsoft Excel удастся сохранить этот файл, внеся в него некоторые исправления. Чтобы внести исправления в новый файл, нажмите кнопку «Продолжить». Для отмены сохранения файла нажмите кнопку «Отмена».

У меня Windows 11 и Microsoft Office 2016, активированные оба. При попытке сохранить файл, вылезает такая ошибка и при «Продолжить» предлагает место и название для сохранения, но оно не сохраняется, а снова вылазит это окно.
Я могу сохранять данный файл:
с телефона в приложении Office
с другого компьютера, на котором Windows 10 и Microsoft Office 2016
с другого компьютера, на котором Windows 10 и Microsoft Office 2019

Такое самое окно вылезает у человека, у которого тоже ASUS на AMD на Windows 11. Однако у человека с другим жезелом на Windows 11 всё работает.

Подскажите что сделать чтобы оно работало как раньше

Like this post? Please share to your friends:
  • Excel ошибка при сохранении файла ошибка поиска файла
  • Excel ошибка при сохранении документа
  • Excel ошибка при перенаправлении команды приложению excel
  • Excel ошибка при направлении команды приложению 2013
  • Excel ошибка при копировании ячеек