Страницы: 1
RSS
Ошибочное назначение защиты множеству ячеек вместо назначенной небольшой группы (макросом), Описание как в названии
 
Добрый день, уважаемые форумчане.
Есть макрос, который копирует строки с листа "Данные" (выделяются данные от первой строки до первой пустой по столбу А). Затем снимает защиту с листа "Прайс бренды - виды товаров" (здесь пароль "1", т.е единичка, но защищенных ячеек нет), вставляет скопированное на этот лист. После этого обрабатывает вставленное. И потом защищает лист "Прайс бренды - виды товаров" эти же паролем.
Но перед защитой листа макрос должен назначить защиту ячеек ("H8:H9,I16:I21").
Я пытаюсь это сделать, но защита назначается НЕ ТОЛЬКО НА ЭТИ ячейки, а ошибочно НА ВСЕ ВСТАВЛЕННЫЕ ячейки.
Вот и прошу помочь в этом. В тестовом файле этот макрос запускается с кнопки на листе "Прайс бренды - виды товаров". Ячейки, которые должны оказаться защищенными на листе "Прайс бренды - виды товаров" выделил желтым.
Код
Sub Macros1()
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    ''''''''''''''''''''''''''''''
    Worksheets("Данные").Activate
    Dim MyValue1, PreMyValue2, MyValue2
    MyValue1 = Range("A2:A" & Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row 'номер строки первой пустой ячейки в А
    
    Worksheets("Прайс бренды - виды товаров").Activate
    
    ActiveSheet.Unprotect Password:="1" 'Снимаем защиту листа
    ActiveSheet.Range("H8:H9,I16:I21").Locked = True
    
    Cells(1, 16).NumberFormat = "@" '"P1"
    Cells(1, 16) = CStr(MyValue1)
    Set MyValue1 = Worksheets("Прайс бренды - виды товаров").Range("P1")
    Sheets("Данные").Rows("1:" & MyValue1).Copy
    Worksheets("Прайс бренды - виды товаров").Activate
    Sheets("Прайс бренды - виды товаров").Rows("11:11").Select
    ActiveSheet.Paste
        
    'Зафиксируем область
    ActiveWindow.FreezePanes = False
    Range("A14").Select
    ActiveWindow.FreezePanes = True
        
    'Установим фильтры
    Range("D11:I13").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
    
    'Установим форматы
        Range("F14:I20000").Select
    Selection.NumberFormat = "#,##0.00"
    
    'Протянем формулу стоимости
    Range("R1").Select
    ActiveCell.FormulaR1C1 = "=IF(R[15]C[-10]>0,R[15]C[-11]*R[15]C[-10],"""")"
    Range("I16").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]>0,RC[-2]*RC[-1],"""")"
    Range("I16").Select
    Selection.Copy
    Range("I17:I20000").Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("A14:B14").Select 'это чтобы "промотать лист вверх".
        
    Range("P1:R1").Select
    Selection.Clear

    Range("A1").Select
    
    'ActiveSheet.Range("H8:H9,I16:I21").Locked = True
    ActiveSheet.Protect Password:="1" 'Ставим защиту листа
    
    '''''''''''''''''''''''''''''''''''''''''''
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    ActiveWorkbook.Save
End Sub
Изменено: maseur - 15.10.2019 23:24:16
 
Цитата
maseur написал:
ошибочно НА ВСЕ ВСТАВЛЕННЫ
отчего же - у всех копируемых ячеек на листе Данные
Код
.Locked = True
изменяйте свойство при копировании. И теги в сообщении проставьте - модераторы ругаться будут
Соблюдение правил форума не освобождает от модераторского произвола
 
maseur, у Вас уже 272 сообщения и Вы ни разу не видели, как выглядит правильно оформленный код? Исправьте.
 
buchlotnik, благодарю за подсказку. Это я тупанул, конечно.
Юрий М, я последний раз на форуме очень-очень давно был. Подзабылось многое. Простите, пожаалуйста.
Спасибо, что оформление кода исправили.
А теги это "как и где"?

Страницы: 1
Наверх