Выбрать дату в календареВыбрать дату в календаре

Страницы: 1
Смена цвета Автофигуры по условию
 
Здравствуйте, уважаемые гуру VBA Excel. Помогите, пожалуйста, решить следующую задачу.
Есть Книга, содержащая 12-ть Листов, имена которых соответствуют названиям месяцев года, и несколько Листов с другими именами. При открытии Книги запускается макрос, который ставит защиту на все Листы и активирует Лист с именем текущего месяца, снимая с него защиту.
Код
Private Sub Workbook_Open()
Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets
        ws.Protect Password:="123"
    Next ws
        With ThisWorkbook.Sheets(MonthName(Month(Now)))
        .Activate
        .Unprotect Password:="123"
    End With
End Sub

Всё отлично работало, пока не появилась необходимость добавить Автофигуру на Листы с названиями месяцев, которая меняет цвет заливки в зависимости от того, защищён или не защищён Лист.  Добавил в код пару строк и Excel стал выдавать ошибку
Код
Private Sub Workbook_Open()
Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets
        ws.Protect Password:="123"
        ws.Shapes("AutoShape 1").Fill.ForeColor.RGB = vbRed
    Next ws
        With ThisWorkbook.Sheets(MonthName(Month(Now)))
        .Activate
        .Unprotect Password:="123"
        .Shapes("AutoShape 1").Fill.ForeColor.RGB = vbGreen
    End With
End Sub

Понимаю, проблема заключается в том, что Автофигура имеется не на всех Листах, но как изменить код не знаю. Перечитал массу форумов, перепробовал массу разных вариантов – увы, ничего не получается. Помогите, пожалуйста, переписать вышеуказанный код, чтобы выполнялись следующие условия:
1. При открытии Книги защита ставится на ВСЕ Листы.
2. На Листах с названиями месяцев цвет Автофигуры - «Красный».

Заранее благодарю за ответ.
Защита Листов в соответствии с календарём
 
Здравствуйте, уважаемые форумчане! Помогите, пожалуйста, в решении следующей задачи.
Есть Книга содержащая 12 Листов. Названия Листов соответствуют месяцам года (Январь, Февраль и т. д.). В настоящий момент при открытии Книги с помощью Макроса ставиться защита на ВСЕ Листы.
Код
Private Sub Workbook_Open()
    Dim wsSh As Object
    For Each wsSh In Me.Sheets
        Protect_for_User_Non_for_VBA wsSh
    Next wsSh
End Sub

Sub Protect_for_User_Non_for_VBA(wsSh As Worksheet)
    wsSh.Protect Password:="123", UserInterfaceOnly:=True
End Sub

С помощью другого макроса снимаю защиту с нужного мне Листа и работаю с ним, каждый день процедура повторяется ...
Код
Sub Разблокировка()
ActiveSheet.Unprotect Password:="123"
MsgBox ("Защита снята!!!")
End Sub

Вопрос в следующем - возможно ли снятие защиты Листа "привязать" к календарю? Например, сейчас Февраль и при открытии Книги Лист "Февраль" будет без защиты. Послезавтра начинается Март и уже без защиты будет Лист "Март", а Лист "Февраль" становится защищённым.
Заранее благодарен за ответ.
Изменено: samass - 28.02.2024 11:29:16 (Забыл указать, какими пользуюсь Макросами)
Как при удалении данных из ячейки вернуть её первоначальный цвет, изменённый макросом
 

Здравствуйте, уважаемые форумчане!

Ситуация следующая: успешно пользуюсь макросом, написанным камрадом БМВ, недавно в его код для расширения функционала добавил пару строк из другого макроса

Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.FormatConditions.Delete
      With Target
      .FormatConditions.Add Type:=xlExpression, Formula1:=True
      .FormatConditions(1).Interior.Color = RGB (245. 245. 245)
      End With
End Sub

Не уверен, всё ли я правильно сделал с точки зрения орфографии VBA, но макрос работает нормально - теперь при выделении ячейки в диапазоне К:АО в ней появляется число и изменяется её цвет.

Код
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Target, Range("K:AO")) Is Nothing And Target.CountLarge = 1 Then    
    If IsEmpty(Target) And Not IsEmpty(Cells(Target.Row, 9)) Then Target.Value = Cells(Target.Row, "I").Value        
        With Target        
        .FormatConditions.Add Type:=xlExpression, Formula1:=True        
        .FormatConditions(1).Interior.Color = RGB (245. 245. 245)        
        End With    
    End If
End Sub

Иногда необходимо удалить данные из некоторых ячеек вышеназванного диапазона, так вот, проблема заключается в том, что при "очищении" ячейки её цвет не становится прежним (((

В макросе, изменяющем цвет ячейки, выражение "Cells.FormatConditions.Delete" возвращает ячейке прежнее форматирование при выделении другой ячейки, однако, все мои попытки "прикрутить" его к "своему" макросу остались безуспешными ...

Просьба, уважаемые знатоки VBA, прописать в макросе дополнительное условие, при котором ячейке возвращался бы её первоначальный цвет при удалении из неё данных.

Заранее благодарен.

Изменено: samass - 27.02.2020 19:35:18
При выделении ячейки записать в нее значение другой ячейки
 
Здравствуйте, уважаемые знатоки VBA, просьба помочь с Макросом.

Задача заключается в следующем:
- при выделении пустой ячейки диапазона К:АО в ней появлялось бы значение ячейки столбца I этой же строки;
- количество строк изменяется.

Заранее благодарен ...
Изменено: samass - 25.01.2020 16:28:16
Подсчёт процедурных единиц за определённый период времени
 

Здравствуйте, ув. форумчане.

По работе приходится подсчитывать количество пациентов, процедур и процедурных единиц за определённый период времени (месяц, квартал …). Ежемесячно «вручную» считал и заносил в таблицу вышеперечисленные данные, а самостоятельно написанные макросы выдавали сумму этих данных в соответствующих ячейках. Однажды мне надоело считать «крестики» и я решил полностью автоматизировать этот процесс.

С задачей подсчёта количества пациентов с разбивкой по отделениям (в прилагаемом файле - Лист "Пациенты") я справился (Макрос 1). А, вот, с подсчётом количества процедур (Макрос 2) возникли проблемы – в ячейках появляются какие-то «левые» числа. Понимаю, что нужно правильно прописать код макроса, но, к сожалению, в программировании я полный ноль, катастрофически не хватает знаний в области VBA …

Просьба помочь в решении данной задачи (прописать код или ткнуть носом, где «копать»), а с подсчётом единиц, надеюсь, справлюсь сам (опираясь на Ваши советы). Заранее благодарен.

P.S. Несколько дней чтения Форума и поисков в Сети не помогли решить проблему (((

P.P.S. Пользуюсь MS Office 2003.

Изменено: samass - 08.11.2019 23:44:00
Страницы: 1
Наверх