Форум программистов, компьютерный форум, киберфорум
VBA
Войти
Регистрация
Восстановить пароль
 
 
Рейтинг 4.86/29: Рейтинг темы: голосов - 29, средняя оценка - 4.86
4 / 4 / 0
Регистрация: 16.01.2013
Сообщений: 1,228
1

Сохранение листа книги в файле - проблема с защитой листа и привязкой макросов

01.02.2013, 16:14. Показов 5271. Ответов 34
Метки нет (Все метки)

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

вот код который сохраняет лист в файле

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub red_row()
'Application.Worksheet_BeforeDoubleClick = False
Cells.Locked = True
ActiveSheet.Protect
ActiveWorkbook.Save
On Error Resume Next
    Folder$ = "D:\" & Date & "\" '& Worksheets(1).Range("a2") & "\"
    MkDir Folder$    ' создаем папку, если её ещё нет
 
    Filename = Folder & "Проба.xls"    ' полный путь к создаваемому файлу
 
    ' копируем активный лист (при этом создается новая книга)
   Err.Clear: ActiveSheet.Copy: DoEvents
    If Err Then Exit Sub    ' произошла какая-то ошибка при попытке копирования листа
 
    ' сохраняем файл под заданным именем в формате Excel 2003
   ActiveWorkbook.SaveAs Filename, xlWorkbookNormal
    ' закрываем сохраненный файл
   ActiveWorkbook.Close False
End Sub
У меня файл защищен паролем, на некоторые ячейки активны, этот макрос закрывает доступ на все оставшийся активные ячейки (т.е файл теперь полностью защищен от редактирования), сохраняет файл на диск D, но когда я открываю файл сохранный на диске D он активный для редактирования, такое ощущение что макрос на закрытие доступа не сработал, почему так не пойму. И вторая беда можно сохранить файл так чтобы он полностью очистил весь код в макросе, а то когда я открываю сохраненный файл на диске D он ругается на код который прописан в Лист1, а код этот привязан к модулю а модуль не перенеся.
Подскажите пожалуйста как быть мне.
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
01.02.2013, 16:14
Ответы с готовыми решениями:

Проблема с защитой листа таблицы.
сделал табличку + кнопочки (дибавить строку, удалить и т.п.) изначально включена защита листа...

Сохранение листа в новой книги
Доброго времени суток форумчане. Срочно нужна консультация специалистов по данному вопросу....

Копировать содержимое листа одной книги, на лист в новую книгу с присвоением ей имени листа из которого копировали
Всем доброго дня! Помогите пожалуйста написать код, сам не могу написать по причине отсутствия...

Сохранение текущего листа с сохранением имени листа и присвоением новой книге имени текущего листа
Sub Save_as() With Application.FileDialog(msoFileDialogSaveAs) .InitialFileName =...

34
3206 / 956 / 222
Регистрация: 29.05.2010
Сообщений: 2,074
01.02.2013, 18:45 2
А код то нужен или нет?
0
5462 / 1142 / 50
Регистрация: 15.09.2012
Сообщений: 3,447
01.02.2013, 19:17 3
Просто информация: при копировании листа, если в ячейке больше 255 символов, то остальной текст в ячейке обрезается. Если копирование происходит с помощью VBA, то никаких предупреждений не выскакивает о том, что данные будут потеряны.
0
11244 / 3610 / 642
Регистрация: 13.02.2009
Сообщений: 10,774
02.02.2013, 09:51 4
можно сохранить файл так чтобы он полностью очистил весь код в макросе
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
'---------блок удаления всех макросов в книге 
        Set objVBProject = ActiveWorkbook.VBProject
    If objVBProject = 1 Then
        MsgBox "VBProject выбранной книги защищён." & vbCrLf & _
             "     Компоненты не будут удалены.", vbExclamation, "Отмена выполнения"
        Exit Sub
    End If
 
    For Each oVBComponent In objVBProject
        On Error Resume Next
        With oVBComponent
            Select Case .Type
            Case 1    'Модули
                .Collection.Remove oVBComponent
            Case 2    'Модули Класса
                .Collection.Remove oVBComponent
            Case 3    'Формы
                .Collection.Remove oVBComponent
            Case 100    'ЭтаКнига, Листы
                    lCountLines = .CodeModule.CountOfLines
                    .CodeModule.DeleteLines 1, lCountLines
            End Select
        End With
    Next
    Set oVBComponent = Nothing
2
Заблокирован
02.02.2013, 10:16 5
Alex77755, Вы забыли упомянуть про необходимые подготовительные операции (для Excel 2003 они выглядят так) -




1
4 / 4 / 0
Регистрация: 16.01.2013
Сообщений: 1,228
03.02.2013, 19:08  [ТС] 6
Alex77755, выдает такое предупреждение

VBProject выбранной книги защищен. Компоненты не будут удалены.

У меня на книге стоит защита я ее снял

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
Sub red_row()
'Application.Worksheet_BeforeDoubleClick = False
Cells.Locked = True
ActiveSheet.Protect
ActiveWorkbook.Save
Sheets("Услуги").Unprotect Password:="111222"
On Error Resume Next
    Folder$ = "D:\" & Date & "\" '& Worksheets(1).Range("a2") & "\"
    MkDir Folder$    ' создаем папку, если её ещё нет
 
    Filename = Folder & "Питкяранта.xls"    ' полный путь к создаваемому файлу
 
    ' копируем активный лист (при этом создаётся новая книга)
   Err.Clear: ActiveSheet.Copy: DoEvents
    If Err Then Exit Sub    ' произошла какая-то ошибка при попытке копирования листа
 
    ' сохраняем файл под заданным именем в формате Excel 2003
   ActiveWorkbook.SaveAs Filename, xlWorkbookNormal
    ' закрываем сохранённый файл
   ActiveWorkbook.Close False
   Set objVBProject = ActiveWorkbook.VBProject
    If objVBProject = 1 Then
        MsgBox "VBProject выбранной книги защищён." & vbCrLf & _
             "     Компоненты не будут удалены.", vbExclamation, "Отмена выполнения"
        Exit Sub
    End If
 
    For Each oVBComponent In objVBProject
        On Error Resume Next
        With oVBComponent
            Select Case .Type
            Case 1    'Модули
                .Collection.Remove oVBComponent
            Case 2    'Модули Класса
                .Collection.Remove oVBComponent
            Case 3    'Формы
                .Collection.Remove oVBComponent
            Case 100    'ЭтаКнига, Листы
                    lCountLines = .CodeModule.CountOfLines
                    .CodeModule.DeleteLines 1, lCountLines
            End Select
        End With
    Next
    Set oVBComponent = Nothing
    Sheets("Услуги").Protect Password:="111222"
End Sub
но он все равно выдает предупреждение, что мне делать?
0
4 / 4 / 0
Регистрация: 16.01.2013
Сообщений: 1,228
03.02.2013, 19:39  [ТС] 8
Апострофф, у меня оффис 2007 там нет такой надписи в VBA
0
Заблокирован
03.02.2013, 19:49 9
.....
1
Миниатюры
Сохранение листа книги в файле - проблема с защитой листа и привязкой макросов  
4 / 4 / 0
Регистрация: 16.01.2013
Сообщений: 1,228
03.02.2013, 20:01  [ТС] 10
Апострофф, это у меня стоит
0
11244 / 3610 / 642
Регистрация: 13.02.2009
Сообщений: 10,774
04.02.2013, 00:39 11
Visual Basic
1
Sheets("Услуги").Unprotect Password:="111222"
и
VBProject выбранной книги защищен
лист и VBпроект немного разные вещи
1
4 / 4 / 0
Регистрация: 16.01.2013
Сообщений: 1,228
04.02.2013, 08:31  [ТС] 12
Alex77755, у меня стояла защита на редактирование кода, но я ее снял. почему все равно ругается и как можно снять и поставить ее опять, с помощью кода?
0
11244 / 3610 / 642
Регистрация: 13.02.2009
Сообщений: 10,774
04.02.2013, 08:41 13
Колись за что в гугле забанили!?
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub Unprotect_VBA()
    Dim objVBProject As Object, objVBComponent As Object, objWindow As Object
 
    Workbooks.Open "C:\1.xls"
    Set objVBProject = ActiveWorkbook.VBProject
    'просматриваем все окна проекта в поисках окна снятия защиты
    For Each objWindow In objVBProject.VBE.Windows
        ' Type = 6 - это нужное нам окно
        If objWindow.Type = 6 Then
            objWindow.Visible = True
            objWindow.SetFocus: Exit For
        End If
    Next
    'вводим пароль и подтверждаем ввод
    SendKeys "~1234~", True: SendKeys "{ENTER}", True
    'здесь Ваш код по внесению изменений в проект
    Set objVBProject = Nothing: Set objVBComponent = Nothing: Set objWindow = Nothing
    ActiveWorkbook.Close True
End Sub
Добавлено через 3 минуты
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
Set objVBProject = ActiveWorkbook.VBProject
    'просматриваем все окна проекта в поисках окна снятия защиты
    For Each objWindow In objVBProject.VBE.Windows
        ' Type = 6 - это нужное нам окно
        If objWindow.Type = 6 Then
            objWindow.Visible = True
            objWindow.SetFocus: Exit For
        End If
    Next
    'вводим пароль и подтверждаем ввод
    SendKeys "~~", True: SendKeys "{ENTER}", True    
      If ActiveWorkbook.VBProject.Protection = 1 Then
        MsgBox "VBProject выбранной книги защищён." & vbCrLf & _
             "     Компоненты не будут удалены.", vbExclamation, "Отмена выполнения"
            End If
For Each oVBComponent In ActiveWorkbook.VBProject.VBComponents
        On Error Resume Next
        With oVBComponent
            Select Case .Type
            Case 1    'Модули
 
 
                .Collection.Remove oVBComponent
            Case 2    'Модули Класса
                .Collection.Remove oVBComponent
            Case 3    'Формы
                .Collection.Remove oVBComponent
            Case 100    'ЭтаКнига, Листы
                    lCountLines = .CodeModule.CountOfLines
                    .CodeModule.DeleteLines 1, lCountLines
            End Select
        End With
Next
    Set oVBComponent = Nothing
Добавлено через 2 минуты
"~~" - ваш пароль
0
4 / 4 / 0
Регистрация: 16.01.2013
Сообщений: 1,228
04.02.2013, 10:35  [ТС] 14
Alex77755, подскажите как заново поставить пароль, с помощью vba
0
11244 / 3610 / 642
Регистрация: 13.02.2009
Сообщений: 10,774
04.02.2013, 10:44 15
Во первых: А зачем? зачем защищать пустой проект?
И вторая беда можно сохранить файл так чтобы он полностью очистил весь код в макросе
1
4 / 4 / 0
Регистрация: 16.01.2013
Сообщений: 1,228
04.02.2013, 11:50  [ТС] 16
Alex77755, логично, че та туплю. А еще вопросик был, я кодом

Visual Basic
1
2
Cells.Locked = True
ActiveSheet.Protect
закрываю доступ на все активные ячейки, когда файл сохраняется на диск D то он не выполняет этот код, может подскажите можно сделать.

Добавлено через 5 минут
Он очищает не сохраненный файл а рабочий файл, мне нужна чтобы чистил который сохраняю

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
Sub red_row()
'Application.Worksheet_BeforeDoubleClick = False
Cells.Locked = True
ActiveSheet.Protect
ActiveWorkbook.Save
'Sheets("Услуги").Unprotect Password:="111222"
On Error Resume Next
    Folder$ = "D:\" & Date & "\" '& Worksheets(1).Range("a2") & "\"
    MkDir Folder$    ' создаем папку, если её ещё нет
 
    Filename = Folder & "Питкяранта.xls"    ' полный путь к создаваемому файлу
 
    ' копируем активный лист (при этом создаётся новая книга)
   Err.Clear: ActiveSheet.Copy: DoEvents
    If Err Then Exit Sub    ' произошла какая-то ошибка при попытке копирования листа
 
    ' сохраняем файл под заданным именем в формате Excel 2003
   ActiveWorkbook.SaveAs Filename, xlWorkbookNormal
    ' закрываем сохранённый файл
   ActiveWorkbook.Close False
   
   Set objVBProject = ActiveWorkbook.VBProject
    'просматриваем все окна проекта в поисках окна снятия защиты
    For Each objWindow In objVBProject.VBE.Windows
        ' Type = 6 - это нужное нам окно
        If objWindow.Type = 6 Then
            objWindow.Visible = True
            objWindow.SetFocus: Exit For
        End If
    Next
    'вводим пароль и подтверждаем ввод
    SendKeys "rhjn", True: SendKeys "{ENTER}", True
      If ActiveWorkbook.VBProject.Protection = 1 Then
        MsgBox "VBProject выбранной книги защищён." & vbCrLf & _
             "     Компоненты не будут удалены.", vbExclamation, "Отмена выполнения"
            End If
For Each oVBComponent In ActiveWorkbook.VBProject.VBComponents
        On Error Resume Next
        With oVBComponent
            Select Case .Type
            Case 1    'Модули
 
 
                .Collection.Remove oVBComponent
            Case 2    'Модули Класса
                .Collection.Remove oVBComponent
            Case 3    'Формы
                .Collection.Remove oVBComponent
            Case 100    'ЭтаКнига, Листы
                    lCountLines = .CodeModule.CountOfLines
                    .CodeModule.DeleteLines 1, lCountLines
            End Select
        End With
Next
    Set oVBComponent = Nothing
End Sub
Добавлено через 21 минуту
Он очищает не сохраненный файл а рабочий файл, мне нужна чтобы чистил который сохраняю это я исправил

Добавлено через 28 минут
А как сделать чтобы удалялось только отпределнный код, например

Visual Basic
1
2
3
4
Private Sub Worksheet_Change(ByVal Target As Range)
' .......
 
End Sub
0
11244 / 3610 / 642
Регистрация: 13.02.2009
Сообщений: 10,774
04.02.2013, 12:16 17
Visual Basic
1
2
3
4
    ' закрываем сохранённый файл
   ActiveWorkbook.Close False
   
   Set objVBProject = ActiveWorkbook.VBProject
Ну правильно!
Сохраненный файл закрыл! Рабочий стал активным. Трёшь в нём
Удаляй до закрытия файла. И для надёжности делай обращение явным, а не АктивеБук:
Примерно так(не проверяю - пишу на коленке)
Visual Basic
1
2
3
4
NewName = "Питкяранта.xls" 
 Filename = Folder & NewName 
With Workbooks(NewName) 
Set objVBProject = .VBProject
А уже потом закрывать

Добавлено через 7 минут
Visual Basic
1
  .CodeModule.DeleteLines 1, lCountLines
Эта строка удаляет строку кода по номеру.
Удалять лучше снизу, что бы не сбивался счётчик
1
4 / 4 / 0
Регистрация: 16.01.2013
Сообщений: 1,228
04.02.2013, 12:56  [ТС] 18
Alex77755, я где то на сайте видел как можно удалить только листы, просто у меня будет стоят защита на сохраненном файле, а в ЭтаКнига прописан код для группировки, вот и нужно чтобы только удалял макрос в листах
0
11244 / 3610 / 642
Регистрация: 13.02.2009
Сообщений: 10,774
04.02.2013, 13:17 19
Visual Basic
1
2
            Select Case .Type
           Case 100    'ЭтаКнига, Листы
Добавлено через 3 минуты
Ну сделай проверку на имя!!
Visual Basic
1
2
3
4
5
6
7
Sub QWERT()
For Each oVBComponent In ActiveWorkbook.VBProject.VBComponents
        With oVBComponent
            Debug.Print oVBComponent.Name
        End With
Next
End Sub
1
4 / 4 / 0
Регистрация: 16.01.2013
Сообщений: 1,228
04.02.2013, 13:17  [ТС] 20
Alex77755, это я видел, как сделать только листы удалять? И почему после завершения открывается VBA окно, как сделать чтобы не открывалось он а файл сохранялся и закрывался
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
04.02.2013, 13:17

Помощь в написании контрольных, курсовых и дипломных работ здесь.

Сохранение листа в из книги как отдельный файл.xls
Процедура по нажатию кнопки-сохранить к примеру лист3 из текущей книги как отдельный файл.xls с...

Сохранение листа книги в отдельный файл в альбомном виде
Добрый день! Есть данный макрос, он сохраняет лист из книги в отдельный файл, но не совсем так как...

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

В какой папке и в каком файле хранятся записи контакт-листа адресной книги uVNC?
Добрый день! Вопрос по небезызвестному , а точнее для адресной книге для него - VNC Adress...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
20
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2021, vBulletin Solutions, Inc.