Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Изменение макросом защищенного листа - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Изменение макросом защищенного листа (Макросы/Sub)
Изменение макросом защищенного листа
Sancho Дата: Среда, 23.11.2016, 16:47 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 88
Репутация: 0 ±
Замечаний: 0% ±

2007, 2010, 2013
Всем привет.
Не могу заставить макрос вставлять данные с других книг на защищенный лист. [vba]
Код
Sub CollectAllClients()
Dim BazaWb As Workbook 'òåêóùàÿ êíèãà (îáùèé ôàéë)
Dim BazaSht As Worksheet 'ëèñò Áàçà ïîêóïàòåëåé â îáùåì ôàéëå
Dim iTempFileName As String 'èìÿ ïî-î÷åð¸äíî îòêðûâàåìîãî ôàéëà
Dim iPath As String 'ïóòü ê ïàïêå, ãäå ëåæàò âñå ôàéëû
Dim iLastRowBaza As Long 'ïîñëåäíÿÿ çàïîëíåííàÿ ñòðîêà â îáùåì ôàéëå â ñòîëáöå A
Dim iLastRowTempWb As Long 'ïîñëåäíÿÿ çàïîëíåííàÿ ñòðîêà â ïî-î÷åð¸äíî îòêðûâàåìîì ôàéëå â ñòîëáöå A
Dim iNumFiles As Long 'êîëè÷åñòâî îòêðûâàåìûõ ôàéëîâ

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .Calculation = xlManual
        Set BazaWb = ThisWorkbook
        Set BazaSht = BazaWb.Sheets("Лист3")
               
        iPath = BazaWb.Path & "\"
        iTempFileName = Dir(iPath & "*.xlsm")
        Do While iTempFileName <> ""
            If iTempFileName <> BazaWb.Name Then
                With .Workbooks.Open _
                     (Filename:=iPath & iTempFileName, UpdateLinks:=False, ReadOnly:=True)
                     iNumFiles = iNumFiles + 1
                     With .Worksheets("Лист3")
                        'ïîñëåäíÿÿ ñòðîêà â îòêðûòîì ôàéëå
                        If .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1).MergeCells Then
                            iLastRowTempWb = .Cells(Rows.Count, 5).End(xlUp).Row + 1
                        Else
                            iLastRowTempWb = .Cells(Rows.Count, 5).End(xlUp).Row
                        End If
                        'ïîñëåäíÿÿ ñòðîêà â áàçå
                        If BazaSht.Cells(Rows.Count, 1).End(xlUp).MergeCells Then
                            iLastRowBaza = BazaSht.Cells(Rows.Count, 5).End(xlUp).Row + 2
                        Else
                            iLastRowBaza = BazaSht.Cells(Rows.Count, 5).End(xlUp).Row + 1
                        End If
                        
                        'Sheets("Лист3").Protect "111", UserInterfaceOnly:=True
                        
                          .Range(.Cells(5, 1), .Cells(iLastRowTempWb, 35)).Copy Destination:=BazaSht.Cells(iLastRowBaza, 1)
                          
                          
                          
                          
                     End With
                     .Close saveChanges:=False
                End With
            End If
            iTempFileName = Dir
        Loop
        .Calculation = xlAutomatic
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    MsgBox "Èíôîðìàöèÿ ñîáðàíà èç " & iNumFiles & " ôàéëîâ!", vbInformation, "Êîíåö"
End Sub
[/vba]

строку [vba]
Код
Sheets("Лист3").Protect "111", UserInterfaceOnly:=True
[/vba] куда только не впихивал, не помогает.
Подскажите пожалуйста люди добрые.
 
Ответить
СообщениеВсем привет.
Не могу заставить макрос вставлять данные с других книг на защищенный лист. [vba]
Код
Sub CollectAllClients()
Dim BazaWb As Workbook 'òåêóùàÿ êíèãà (îáùèé ôàéë)
Dim BazaSht As Worksheet 'ëèñò Áàçà ïîêóïàòåëåé â îáùåì ôàéëå
Dim iTempFileName As String 'èìÿ ïî-î÷åð¸äíî îòêðûâàåìîãî ôàéëà
Dim iPath As String 'ïóòü ê ïàïêå, ãäå ëåæàò âñå ôàéëû
Dim iLastRowBaza As Long 'ïîñëåäíÿÿ çàïîëíåííàÿ ñòðîêà â îáùåì ôàéëå â ñòîëáöå A
Dim iLastRowTempWb As Long 'ïîñëåäíÿÿ çàïîëíåííàÿ ñòðîêà â ïî-î÷åð¸äíî îòêðûâàåìîì ôàéëå â ñòîëáöå A
Dim iNumFiles As Long 'êîëè÷åñòâî îòêðûâàåìûõ ôàéëîâ

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .Calculation = xlManual
        Set BazaWb = ThisWorkbook
        Set BazaSht = BazaWb.Sheets("Лист3")
               
        iPath = BazaWb.Path & "\"
        iTempFileName = Dir(iPath & "*.xlsm")
        Do While iTempFileName <> ""
            If iTempFileName <> BazaWb.Name Then
                With .Workbooks.Open _
                     (Filename:=iPath & iTempFileName, UpdateLinks:=False, ReadOnly:=True)
                     iNumFiles = iNumFiles + 1
                     With .Worksheets("Лист3")
                        'ïîñëåäíÿÿ ñòðîêà â îòêðûòîì ôàéëå
                        If .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1).MergeCells Then
                            iLastRowTempWb = .Cells(Rows.Count, 5).End(xlUp).Row + 1
                        Else
                            iLastRowTempWb = .Cells(Rows.Count, 5).End(xlUp).Row
                        End If
                        'ïîñëåäíÿÿ ñòðîêà â áàçå
                        If BazaSht.Cells(Rows.Count, 1).End(xlUp).MergeCells Then
                            iLastRowBaza = BazaSht.Cells(Rows.Count, 5).End(xlUp).Row + 2
                        Else
                            iLastRowBaza = BazaSht.Cells(Rows.Count, 5).End(xlUp).Row + 1
                        End If
                        
                        'Sheets("Лист3").Protect "111", UserInterfaceOnly:=True
                        
                          .Range(.Cells(5, 1), .Cells(iLastRowTempWb, 35)).Copy Destination:=BazaSht.Cells(iLastRowBaza, 1)
                          
                          
                          
                          
                     End With
                     .Close saveChanges:=False
                End With
            End If
            iTempFileName = Dir
        Loop
        .Calculation = xlAutomatic
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    MsgBox "Èíôîðìàöèÿ ñîáðàíà èç " & iNumFiles & " ôàéëîâ!", vbInformation, "Êîíåö"
End Sub
[/vba]

строку [vba]
Код
Sheets("Лист3").Protect "111", UserInterfaceOnly:=True
[/vba] куда только не впихивал, не помогает.
Подскажите пожалуйста люди добрые.

Автор - Sancho
Дата добавления - 23.11.2016 в 16:47
buchlotnik Дата: Среда, 23.11.2016, 17:24 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 2049
Репутация: 613 ±
Замечаний: 0% ±

2010, 2013, 2016 RUS / ENG
Sancho, [vba]
Код
UserInterfaceOnly:=True
[/vba] надо использовать при постановке защиты на лист.
А вот если он уже запаролен ручками - только через [vba]
Код
Sheets("Лист3").Unprotect Password:="111"
[/vba]


платная помощь:
ЯД: 410012595572239; WM: 311017577133
buchlotnik@mail.ru


Сообщение отредактировал buchlotnik - Среда, 23.11.2016, 17:24
 
Ответить
СообщениеSancho, [vba]
Код
UserInterfaceOnly:=True
[/vba] надо использовать при постановке защиты на лист.
А вот если он уже запаролен ручками - только через [vba]
Код
Sheets("Лист3").Unprotect Password:="111"
[/vba]

Автор - buchlotnik
Дата добавления - 23.11.2016 в 17:24
Sancho Дата: Среда, 23.11.2016, 17:41 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 88
Репутация: 0 ±
Замечаний: 0% ±

2007, 2010, 2013
buchlotnik, да ручками защищен, но подставленная строка [vba]
Код
UserInterfaceOnly:=True
[/vba] успешно работает в другом коде который тупо очищает эти ячейки. Я в этом коде понять не могу в какой момент происходит вставка - copy вижу, а paste нет. Заполнение ячеек происходит после выполнения этой строки[vba]
Код
.Range(.Cells(5, 1), .Cells(iLastRowTempWb, 35)).Copy Destination:=BazaSht.Cells(iLastRowBaza, 1)
[/vba]
 
Ответить
Сообщениеbuchlotnik, да ручками защищен, но подставленная строка [vba]
Код
UserInterfaceOnly:=True
[/vba] успешно работает в другом коде который тупо очищает эти ячейки. Я в этом коде понять не могу в какой момент происходит вставка - copy вижу, а paste нет. Заполнение ячеек происходит после выполнения этой строки[vba]
Код
.Range(.Cells(5, 1), .Cells(iLastRowTempWb, 35)).Copy Destination:=BazaSht.Cells(iLastRowBaza, 1)
[/vba]

Автор - Sancho
Дата добавления - 23.11.2016 в 17:41
Wasilich Дата: Четверг, 24.11.2016, 11:23 | Сообщение № 4
Группа: Друзья
Ранг: Ветеран
Сообщений: 858
Репутация: 220 ±
Замечаний: 0% ±

2003
строку
Sheets("Лист3").Protect "111", UserInterfaceOnly:=True
куда только не впихивал, не помогает.
В модуль книги:
[vba]
Код
Private Sub Workbook_Open()
    Sheets("Лист3").Protect Password:="111", userinterfaceonly:=True
End Sub
[/vba]Или так
[vba]
Код
Sheets("Лист3").Unprotect Password:="111" ' снять защиту
.Range(.Cells(5, 1), .Cells(iLastRowTempWb, 35)).Copy Destination:=BazaSht.Cells(iLastRowBaza, 1)
Sheets("Лист3").Protect Password:="111" ' поставить защиту
[/vba]
 
Ответить
Сообщение
строку
Sheets("Лист3").Protect "111", UserInterfaceOnly:=True
куда только не впихивал, не помогает.
В модуль книги:
[vba]
Код
Private Sub Workbook_Open()
    Sheets("Лист3").Protect Password:="111", userinterfaceonly:=True
End Sub
[/vba]Или так
[vba]
Код
Sheets("Лист3").Unprotect Password:="111" ' снять защиту
.Range(.Cells(5, 1), .Cells(iLastRowTempWb, 35)).Copy Destination:=BazaSht.Cells(iLastRowBaza, 1)
Sheets("Лист3").Protect Password:="111" ' поставить защиту
[/vba]

Автор - Wasilich
Дата добавления - 24.11.2016 в 11:23
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Изменение макросом защищенного листа (Макросы/Sub)
Страница 1 из 11
Поиск:

Яндекс цитирования
© 2010-2016 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!