Microsoft Excel:

  Таблицы и VBA. Справочник.
  Вопросы и Ответы. Советы. Примеры.
Меню FAQ | Макросы | Range (Cells)


Rambler's Top100


Counter CO.KZ


    [1] [2] [3] [4] [5] [6]

  1. Как сделать так, чтобы ячейка пульсировала(мигала) после ввода определённого значения ? 25.03.2007
  2. Как в рабочем листе запретить ввод или вставку скопированных данных содержащих текст ? 14.04.2007
  3. Как в определённом диапазоне запретить ввод или вставку скопированных данных содержащих текст ? 14.04.2007
  4. Как в рабочем листе запретить ввод или вставку скопированных данных содержащих числа ? 14.04.2007
  5. Как в определённом диапазоне запретить ввод или вставку скопированных данных содержащих числа ? 14.04.2007
  6. Как в рабочем листе или определённых ячейках листа запретить ввод, редактирование или вставку скопированных данных, содержащих формулы ? 15.09.2007
  7. Как сделать так, чтобы скопированные данные игнорировались в событии Worksheet_Change , Workbook_SheetChange ? NEW 30.05.2018
  8. Как сделать так, чтобы после выделения любой ячейки - был автоматически выделен столбец и строка, которым принадлежит эта ячейка ? 05.04.2007
  9. Как сделать так, чтобы после выделения ячейки или диапазона ячеек - активная ячейка стала самой верхней левой ячейкой ? 08.04.2007
  10. Как сделать так, чтобы после выделения ячейки или диапазона ячеек - активная ячейка центрировалась относительно окна рабочей книги ? 27.04.2007
  11. Как сделать так, чтобы при выделении ячейки содержащей нужное значение, был автоматически создан выпадающий список с необходимыми данными ? 08.04.2007
  12. Как после выделения любой ячейки нужного диапазона, отобразить на экране стандартный калькулятор ? 01.05.2008
  13. Как при выделении нужной ячейки автоматически отобразить UserForm ? 12.04.2007
  14. Как поменять местами значения двух выделенных ячеек ? 07.04.2007
  15. Как поменять местами значения двух выделенных диапазонов ? 29.04.2007
  16. Как в нужном столбце подсчитать общее количество каждого имеющегося там значения (с учётом возможных проблем) ? 18.04.2007
  17. Как ограничить перемешение только нужным диапазоном ячеек ? 11.03.2006
  18. Как перемещаться только по незаблокированным ячейкам ? 29.04.2007
    [1] [2] [3] [4] [5] [6]


  • Ответ : Скачать пример Актуально для MS Excel 97, 2000, XP

    Для того, чтобы после ввода, например, в ячейку "B50" числа > 100 эта ячейка начала пульсировать / менять цвет заливки - разместите весь нижеприведённый код в модуле нужного рабочего листа [FAQ31]

    Вариант I.
  • Private Sub Worksheet_Change(ByVal Target As Excel.Range) 
        If Not Intersect(Target, Me.Range("B50")) Is Nothing Then 
           With Me.Range("B50") 
                If IsPulsar(.Cells, 100) = True Then 
                   If Me.ProtectContents = True Then 
                      MsgBox "Пульсация невозможна", vbCritical + _ 
                      vbSystemModal, "Снимите защиту листа" 
                      Exit Sub 
                   End If 
                   Application.EnableCancelKey = xlDisabled 
                   If Intersect(ActiveWindow.VisibleRange, .Cells) Is Nothing Then 
                      Application.Goto Reference:=.Cells ', Scroll:=True 
                   End If 
                   iColor& = .Interior.Color 
                   For iCount% = 1 To 10 
                       .Interior.Color = IIf(iCount% Mod 2 = 0, vbWhite, vbRed) 
                       Application.Wait Time:=DateAdd("s", 1, Now) 
                   Next 
                   .Interior.Color = iColor& 
                   Application.EnableCancelKey = xlInterrupt 
                End If 
           End With 
        End If 
    End Sub 
    
    Private Function IsPulsar(Cell As Excel.Range, Criteria#) As Boolean 
        If IsNumeric(Cell) = True Then 
           IsPulsar = (Cell > Criteria) 
        End If 
    End Function
    Примечание : В этом варианте, изменение цвета заливки произойдёт даже в том случае, если изменяемая ячейка не видна на экране.

    Вариант II.
    Private Sub Worksheet_Change(ByVal Target As Excel.Range) 
        If Intersect([B50], Target, ActiveWindow.VisibleRange. _ 
           SpecialCells(xlVisible)) Is Nothing Then Exit Sub 
           If IsPulsar([B50], 100) = True Then 
              If Me.ProtectContents = True Then 
                 MsgBox "Пульсация невозможна", vbCritical + _ 
                 vbSystemModal, "Снимите защиту листа": Exit Sub 
              End If 
              Application.EnableCancelKey = xlDisabled 
              For Each iColor In Array(vbYellow, vbGreen, _ 
                  vbCyan, vbBlue, vbRed, [B50].Interior.Color) 
                  Application.Wait Time:=DateAdd("s", 1, Now) 
                  [B50].Interior.Color = iColor 
              Next 
              Application.EnableCancelKey = xlInterrupt 
           End If 
    End Sub 
    
    Private Function IsPulsar(Cell As Excel.Range, Criteria#) As Boolean 
        If IsNumeric(Cell) = True Then _ 
           IsPulsar = (Cell > Criteria) 
    End Function
    Примечание : В этом варианте, изменение цвета заливки произойдёт только при условии, что изменяемая ячейка видна на экране. Это ограничение актуально, если изменение может происходить в диапазоне ячеек, например, при копировании целого столбца.

    Комментарий : [Параметры форматирования] [Событие Worksheet_Change]

    Bonus : Пример, позволяющий изменять цвет с частотой менее одной секунды, можно скачать здесь.
  • Ответ : Скачать пример Актуально для MS Excel 97, 2000, XP

    Для того, чтобы отменить ввод или вставку скопированных данных, если в результате этих действий, хотя бы одна ячейка будет содержать текст - разместите весь нижеприведённый код в модуле нужного рабочего листа [FAQ31]
  • Private Sub Worksheet_Change(ByVal Target As Excel.Range) 
        With Application 
             If .Count(Target) <> .CountA(Target) Then 
                .EnableEvents = False 
                .Undo 
                .EnableEvents = True 
             End If 
        End With 
    End Sub
    Обратите внимание на :
  • [Событие Worksheet_Change]
  • то, что текст, это не только слова и предложения, но и например пробел(ы)
  • то, что формулы, после пересчёта, могут возвращать текст
  • то, что если же Вы планируете ввод данных только непосредственно с клавиатуры, то запретить ввод текста можно вообще без использования макросов [FAQ]
  • Ответ : Скачать пример Актуально для MS Excel 97, 2000, XP

    Для того, чтобы отменить ввод или вставку скопированных данных, если в результате этих действий, хотя бы одна ячейка определённого диапазона, например, "A2:C100,E2:E100" будет содержать текст - разместите весь нижеприведённый код в модуле нужного рабочего листа [FAQ31]
  • Private Sub Worksheet_Change(ByVal Target As Excel.Range) 
        Dim iTarget As Range 
        Set iTarget = Intersect(Target, Me.Range("A2:C100,E2:E100")) 
        If Not iTarget Is Nothing Then 
           With Application 
                If .Count(iTarget) <> .CountA(iTarget) Then 
                   .EnableEvents = False 
                   .Undo 
                   .EnableEvents = True 
                End If 
           End With 
        End If 
    End Sub
    Комментарий : [См. выше]
  • Ответ : Актуально для MS Excel 97, 2000, XP

    Для того, чтобы отменить ввод или вставку скопированных данных, если в результате этих действий, хотя бы одна ячейка будет содержать число - разместите весь нижеприведённый код в модуле нужного рабочего листа [FAQ31]
  • Private Sub Worksheet_Change(ByVal Target As Excel.Range) 
        With Application 
             If .Count(Target) > 0 Then 
                .EnableEvents = False 
                .Undo 
                .EnableEvents = True 
             End If 
        End With 
    End Sub
    Обратите внимание на :
  • [Событие Worksheet_Change]
  • то, что формулы, после пересчёта, могут возвращать числа
  • то, что дата, по сути, также является числом, поэтому, запрет также касается и дат.
  • то, что если же Вы планируете ввод данных только непосредственно с клавиатуры, то запретить ввод чисел можно вообще без использования макросов [FAQ]
  • Ответ : Актуально для MS Excel 97, 2000, XP

    Для того, чтобы отменить ввод или вставку скопированных данных, если в результате этих действий, хотя бы одна ячейка определённого диапазона, например, "A2:A100,C2:C100" будет содержать число - разместите весь нижеприведённый код в модуле нужного рабочего листа [FAQ31]
  • Private Sub Worksheet_Change(ByVal Target As Excel.Range) 
        Dim iTarget As Range 
        Set iTarget = Intersect(Target, Me.Range("A2:A100,C2:C100")) 
        If Not iTarget Is Nothing Then 
           With Application 
                If .Count(iTarget) > 0 Then 
                   .EnableEvents = False 
                   .Undo 
                   .EnableEvents = True 
                End If 
           End With 
        End If 
    End Sub
    Private Sub Worksheet_Change(ByVal Target As Excel.Range) 
        With Application 
             If Not .Intersect(Target, [A2:A100,C2:C100]) Is Nothing Then 
                If .Count(.Intersect(Target, [A2:A100,C2:C100]) > 0 Then 
                   .EnableEvents = False 
                   .Undo 
                   .EnableEvents = True 
                End If 
             End If 
        End With 
    End Sub
    Комментарий : [См. выше]
  • Ответ : Актуально для MS Excel 97, 2000, XP

    Для того, чтобы отменить ввод, редактирование или вставку скопированных данных, если в результате этих действий, хотя бы одна ячейка будет содержать формулу - достаточно скопировать любой из двух нижеприведённых кодов в модуль нужного рабочего листа [FAQ31]
  • Private Sub Worksheet_Change(ByVal Target As Excel.Range) 
        If Not Target.Find(What:="=*", _ 
           LookIn:=xlFormulas, LookAt:=xlWhole) Is Nothing Then 
           With Application 
                .EnableEvents = False 
                .Undo 
                .EnableEvents = True 
           End With 
        End If 
    End Sub
    Private Sub Worksheet_Change(ByVal Target As Excel.Range) 
        If Target.HasFormula = True Or _ 
           IsNull(Target.HasFormula) = True Then 
           With Application 
                .EnableEvents = False 
                .Undo 
                .EnableEvents = True 
           End With 
        End If 
    End Sub
    Комментарий : Второй вариант лишён двух недостатков, которые перечислены здесь и представляют собой два последних пункта.

    Для того, чтобы подобный запрет касался не всех ячеек рабочего листа, а только ячеек определённого диапазона, в данном примере это "A2:A100,C2:C100,F2", достаточно использовать следующий код (можно использовать и второй вариант) :
    Private Sub Worksheet_Change(ByVal Target As Excel.Range) 
        Dim iTarget As Range 
        Set iTarget = Intersect(Target, [A2:A100,C2:C100,F2]) 
        If iTarget Is Nothing Then Exit Sub 
    
        If Not iTarget.Find(What:="=*", _ 
           LookIn:=xlFormulas, LookAt:=xlWhole) Is Nothing Then 
           With Application 
                .EnableEvents = False 
                .Undo 
                .EnableEvents = True 
           End With 
        End If 
    End Sub

  • Ответ : Актуально для MS Excel 97-2003

    Если Вам необходимо, чтобы события Worksheet_Change , Workbook_SheetChange не обрабатывали данные, которые были получены с помощью копирования, добавьте проверку, а именно :
  • Private Sub Worksheet_Change(ByVal Target As Excel.Range)
        If Application.CutCopyMode = xlCopy Then Exit Sub
        
        'Здесь Вы можете быть уверены, что данные не были
        'скопированы вручную, или даже программно, но с
        'строго с использованием буфера обмена
    End Sub

  • Ответ : Скачать пример Актуально для MS Excel 97, 2000, XP

    Для того, чтобы после выделения любой ячейки был автоматически выделен весь столбец и вся строка, на пересечении которых находится выделенная ячейка - разместите весь нижеприведённый код в модуле нужного рабочего листа [FAQ31]
  • Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) 
        If Target.Count = 1 Then 
           Application.EnableEvents = False 
           Union(Target.EntireColumn, Target.EntireRow).Select 
           Target.Activate 
           Application.EnableEvents = True 
        End If 
    End Sub
    Комментарий : Если же Вас устроит вариант, при котором, при выделении столбца и строки будет повторно вызвано событие Worksheet_SelectionChange, то :
    Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) 
        If Target.Count = 1 Then _ 
           Union(Target.EntireColumn, Target.EntireRow).Select: Target.Activate 
    End Sub

  • Ответ : Скачать пример Актуально для MS Excel 97, 2000, XP

    Вариант I.
  • Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) 
        With ActiveWindow 
             .ScrollRow = .ActiveCell.Row 
             .ScrollColumn = .ActiveCell.Column 
        End With 
    End Sub
    Вариант II.
    Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) 
        Application.Goto Reference:=ActiveCell, Scroll:=True 
    End Sub
    Комментарий : В подавляющем большинстве случаев, особенно при работе с событием Worksheet_Change, более разумно использовать об'ект Target, т.к. он представляет все выделенные ячейки (событие Worksheet_SelectionChange)
    Однако, этот пример является редким исключением, потому, что в поставленной задаче фигурирует именно активная ячейка, а первая ячейка выделенного диапазона не всегда является таковой. Наглядным примером таких исключений: может являться диапазон "B5:F9,D7" или "F10:D3"
  • Ответ : Скачать пример Актуально для MS Excel 97, 2000, XP
  • Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) 
        With ActiveWindow.VisibleRange 
             iRow& = .Row + (.Rows.Count \ 2) - 1 
             iColumn% = .Column + (.Columns.Count \ 2) - 1 
        End With 
        ActiveWindow.SmallScroll _ 
        Down:=ActiveCell.Row - iRow&, ToRight:=ActiveCell.Column - iColumn% 
    End Sub
    Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) 
        With ActiveWindow 
             With .VisibleRange 
                  iRow& = .Row + (.Rows.Count \ 2) - 1 
                  iColumn% = .Column + (.Columns.Count \ 2) - 1 
             End With 
             .SmallScroll _ 
             Down:=.ActiveCell.Row - iRow&, _ 
             ToRight:=.ActiveCell.Column - iColumn% 
        End With 
    End Sub
    Комментарий :
  • В некоторых случаях, например, при чётном количестве строк/столбцов, наличии закреплённой области - центрирование будет несколько относительное. А при при выделении, например, ячейки "A1" его, по понятным причинам, не будет вообще.
  • [См. выше]
  • Ответ : Скачать пример Актуально для MS Excel 97, 2000, XP

    Для того, чтобы при выделении ячейки в первом столбце, содержащей нужное значение : "Радуга" или "РАДУГА" (регистр символов, в данном случае, не важен) был автоматически создан и отображён выпадающий список с необходимыми данными (все цвета радуги) А после выбора нужного значения, этот список был удалён, достаточно использовать нижеприведённый код, который необходимо разместить в модуле нужного рабочего листа [FAQ31]
  • Option Compare Text 
    
    Private Sub Worksheet_Change(ByVal Target As Excel.Range) 
        If Target.Column = 1 Then _ 
           Cell_Validation Target(1), False 
    End Sub 
    
    Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) 
        If Target.Column = 1 Then _ 
           Cell_Validation Target(1), True 
    End Sub 
    
    Private Sub Cell_Validation(ByVal Cell As Excel.Range, ByVal Drop_Down As Boolean) 
        With Cell.Validation 
             .Delete 
             If Not Me.ProtectContents And CStr(Cell) = "Радуга" Then 
                .Add Type:=xlValidateList, _ 
                Formula1:="Красный,Оранжевый,Жёлтый,Зелёный,Голубой,Синий,Фиолетовый" 
                If Drop_Down = True Then Application.SendKeys Keys:="%{DOWN}" 
                'Отображение выпадающего списка использовать по необходимости 
             End If 
        End With 
    End Sub
    Примечание : Столбец, значение, а также список всех цветов радуги, использованы исключительно в качестве примера и могут быть изменены в соответствии с Вашими требованиями. Однако строка, где перечислены всех элементы списка, не должна содержать более 255 символов (включая разделители ,)

    Комментарий : В данном примере предполагается, что в столбце, где находится нужное значение, не должно быть ячеек, содержащих проверку данных. Это условие не является обязательным и может быть анулировано, но только после соответствующего изменения в коде.
  • Ответ :

    Для того, чтобы после выделения любой ячейки столбца "D", Вы могли воспользоваться стандартным калькулятором Windows, достаточно скопировать весь нижеприведённый код в модуль нужного рабочего листа [FAQ31]
  • Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) 
        If Not Intersect(Target, [D:D]) Is Nothing _ 
           Then Application.ActivateMicrosoftApp 0 
    End Sub

  • Ответ : Скачать пример

    Для того, чтобы поменять местами значения двух нужных ячеек, выделите предварительно эти ячейки, при этом допускается выделение несмежных ячеек [FAQ] и выполните следующий макрос.
  • Private Sub TwoCells_SwapValue() 
        If Not TypeOf Selection Is Range Then 
           MsgBox "Необходимо выделить две ячейки, а не " & _ 
           TypeName(Selection), vbCritical + vbSystemModal, "" 
           Exit Sub 
        End If 
        With Selection 
             If .Count <> 2 Then 
                MsgBox "Необходимо выделить только две ячейки, а не " & _ 
                .Count, vbCritical + vbSystemModal, "" 
                Exit Sub 
             End If 
             If .Locked = True And .Parent.ProtectContents = True Then 
                MsgBox "Снимите защиту листа", vbCritical + vbSystemModal, "" 
                Exit Sub 
             End If 
             If .Areas.Count = 1 Then 
                iValue = .Item(1).Value 
                .Item(1).Value = .Item(2).Value 
                .Item(2).Value = iValue 
             Else 
                iValue = .Areas(1).Value 
                .Areas(1).Value = .Areas(2).Value 
                .Areas(2).Value = iValue 
             End If 
        End With 
    End Sub
    Примечание : При обмене значениями - параметры форматирования не учитываются.
  • Ответ : Скачать пример

    Для того, чтобы поменять местами значения двух несмежных диапазонов, состоящих из равного количества ячеек, выделите предварительно эти диапазоны и выполните следующий макрос.
  • Private Sub TwoRange_SwapValue() 
        If Not TypeOf Selection Is Range Then 
           MsgBox "Необходимо выделить две ячейки, а не " & _ 
           TypeName(Selection), vbCritical, "": Exit Sub 
        End If 
        With Selection 
             If .Areas.Count <> 2 Then 
                MsgBox "Необходимо выделить только два диапазона", _ 
                vbCritical, "": Exit Sub 
             End If 
             If .Areas(1).Count <> .Areas(2).Count Then 
                MsgBox "Количество ячеек должно быть идентичным", _ 
                vbCritical, "": Exit Sub 
             End If 
             If .Locked = True And .Parent.ProtectContents = True Then 
                MsgBox "Снимите защиту листа", vbCritical, "": Exit Sub 
             End If 
             If .Areas(1).Rows.Count = .Areas(2).Rows.Count Then 
                iValue = .Areas(1).Value 
                .Areas(1).Value = .Areas(2).Value 
                .Areas(2).Value = iValue 
             Else 
                iValue = .Areas(1).Value 
                .Areas(1).Value = Application.Transpose(.Areas(2).Value) 
                .Areas(2).Value = Application.Transpose(iValue) 
             End If 
        End With 
    End Sub
    Примечание : При обмене значениями - параметры форматирования не учитываются.
  • Ответ : Скачать пример Актуально для MS Excel 97, 2000, XP

    Для того, чтобы подсчитать общее количество каждого значения в указанном столбце можно использовать, в т.ч. и программно, стандартную функцию рабочего листа =СЧЁТЕСЛИ() Но эта функция имеет свои особенности, в частности, при работе с числами эта функция учитывает только первые 17 цифр. И это особенно актуально, если речь идёт о "числах" хранящихся в виде текста, т.к. в этом случае 00623800000042263000=00623800000042263680

    Нижеприведённый код, который можно разместить: либо в модуле нужного рабочего листа [FAQ31], либо в стандартном модуле, заменив при этом ключевое слово Me ссылкой на нужный рабочий лист, решает эту проблему :
  • Private Sub CountDifference() 
        With Me.UsedRange.Columns(1) 
             iCountA& = Application.CountA(.Cells) 
             Dim iCell As Range 
             For Each iCell In .Cells 
                 iCount& = iCountA& - .Cells.ColumnDifferences(iCell).Count 
                 MsgBox iCell.Value & "-" & iCount&, , "" 
             Next 
        End With 
    End Sub
    Комментарий :
  • Если в списке будет только одно единственное значение, в т.ч. и повторяющееся, то в этом случае, Вы получите ошибку. Это условие не актуально, если UsedRange.Columns(1) будет содержать пустые ячейки.
  • Однако, наличие пустых ячеек, приведёт к получению некорректного результата.
  • Нежелательно наличие ячеек, содержащих значение ошибки.
  • Кроме того, применение метода ColumnDifferences вызывает событие Worksheet_SelectionChange и аналогичные события рабочей книги, приложения. Впрочем, это можно предотвратить, если использовать этот совет.
  • Если рабочий лист защищён, то использование вышеупомянутого метода приведёт к возникновению ошибки, которую можно избежать, если воспользоваться этим советом.

    Следующий код решает все вышеперечисленные проблемы :
  • Private Sub CountCoincideText() 
        On Error GoTo ErrHandler 
        If Me.ProtectContents = True Then 
           MsgBox "Снимите защиту листа : " & Me.Name & vbCrLf & _ 
           "или воспользуйтесь следующим советом :" & vbCrLf & _ 
           "http://www.msoffice.nm.ru/faq/macros/worksheets.htm#faq42", , "" 
           Exit Sub 
        End If 
        Application.EnableEvents = False 
        With Me.UsedRange.Columns(1) 
             iCountC& = .Cells.Count 
             Dim iCell As Range 
             For Each iCell In .Cells 
                 If Not IsEmpty(iCell) Then 
                    iCount& = iCountC& - .Cells.ColumnDifferences(iCell).Count 
                    MsgBox iCell.Text & "-" & iCount&, , "" 
                 End If 
             Next 
        End With 
    ErrHandler: 
        Application.EnableEvents = True 
        If Err.Number <> 0 Then 
           'Здесь могут быть Ваши инструкции 
        End If 
    End Sub

  • Ответ : Актуально для MS Excel 97, 2000, XP
  • Лист1.ScrollArea = "C3:E15"
    Worksheets(1).ScrollArea = "C3:E15"
    Worksheets("Sales").ScrollArea = "C3:E15"
    Предполагается, что :
  • Лист1 - это кодовое/программное имя рабочего листа
  • 1 - это индекс рабочего листа
  • Sales - это имя рабочего листа
  • Ответ : Скачать пример

    Для того, чтобы в нужном рабочем листе можно было перемещаться только по незаблокированным/незащищённым ячейкам, можно проделать следующее :

    Выделите все ячейки рабочего листа и в меню Формат выберите команду Ячейки. Затем, в появившемся диалоговом окне выберите закладку Защита и установите "флажок" напротив Защищаемая ячейка. После этого выделите все ячейки, в которых предполагается разрешить изменения (при этом разрешается выделение несмежных ячеек/диапазонов) и в меню Формат опять выберите команду Ячейки. После чего, снимите "флажок" напротив Защищаемая ячейка и :

    Вариант I(а) Актуально для MS Excel 95, 97, 2000, XP
  • Private Sub Auto_Open() 
        Worksheets(1).OnSheetActivate = "EnabledSelection" 'Or 
        'Worksheets("Sales").OnSheetActivate = "EnabledSelection" 
    End Sub 
    
    Private Sub EnabledSelection() 
        With Application 
             .ScreenUpdating = False 
             .Goto Reference:=.Cells 
             .DataEntryMode = xlOn 'xlStrict 
             .ScreenUpdating = True 
        End With 
    End Sub
    Предполагается, что :
  • 1 - это индекс рабочего листа
  • Sales - это имя рабочего листа

    Вариант I(б) Актуально для MS Excel 97, 2000, XP

    Скопируйте следующий код в модуль нужного рабочего листа [FAQ31]
  • Private Sub Worksheet_Activate() 
        If ActiveWindow.SelectedSheets.Count = 1 Then 
           With Application 
                .ScreenUpdating = False 
                .Cells.Select 
                .DataEntryMode = xlOn 'xlStrict 
                .ScreenUpdating = True 
           End With 
        Else: MsgBox "Выделите только один лист", , "" 
        End If 
    End Sub
    Примечание : Событие Worksheet_Activate() не будет выполнено, если :
    - при открытии рабочей книги нужный лист уже будет активным
    - переход будет осуществлён с использованием гиперссылки
    (актуально только для MS Excel 97, 2000)
    - переход к ячейке/диапазону ячеек этого рабочего листа, будет осуществлён с помощью поля со списком Имя, которое находится в строке формул, или с использованием стандартного диалогового окна Переход
    (актуально только для MS Excel 97, 2000)

    Комментарий :
  • Если использовать константу xlStrict, то блокировку нельзя будет снять используя клавишу ESC
  • Вместо всех ячеек рабочего листа Cells можно указать вполне опредёленный диапазон, например, Range("A1:K20")
  • Используя этот способ, Вы теряете возможность взаимодействия с большинством стандартных команд

    Вариант II(а) Актуально для MS Excel 97, 2000, XP

    Установите значение свойства EnableSelection об'екта Worksheet как xlUnlockedCells и защитите нужный рабочий лист. Изменить значение этого свойства можно как вручную (в редакторе VBA) так и программно, но в любом случае, это необходимо делать каждый раз при открытии рабочей книги. При выборе программного способа можно использовать этот [FAQ61] например :
  • Private Sub Workbook_Open() 
        Лист1.EnableSelection = xlUnlockedCells 'Or 
        'Worksheets(1).EnableSelection = xlUnlockedCells 'Or 
        'Worksheets("Sales").EnableSelection = xlUnlockedCells 
    End Sub
    Предполагается, что :
  • Лист1 - это кодовое/программное имя рабочего листа
  • 1 - это индекс рабочего листа
  • Sales - это имя рабочего листа

    Вариант II(б) Актуально для MS Excel XP

    В меню Сервис выберите пункт Защита и команду Защитить лист. Затем, в появившемся диалоговом окне, обязательно установите "флажки" напротив Защитить лист и содержимое защищаемых ячеек и Выделение незаблокированных ячеек и снимите "флажок" напротив Выделение заблокированных ячеек. После чего, введите пароль (учитывая размер регистра и раскладку клавиатуры) и нажмите кнопку ОК. Далее повторите ввод пароля и опять нажмите кнопку ОК.
    Воспроизведение любых опубликованных здесь материалов возможно только с письменного разрешения автора : Microsoft Excel 95, 97, 2000, XP

  • © 2004-2018 Климов П.Ю. Все права защищены. WebDesign & Error's Klimoff