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 ? 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
  19. Как определить, когда были выделены все ячейки листа или целиком вся строка/столбец ? NEW 29.06.2020
    [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

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

    Для того, чтобы отловить момент, когда пользователь выделит все ячейки рабочего листа или целиком всю строку/столбец, разместите следующее событие в модуле листа [FAQ31], где будут происходить все эти выделения диапазонов.
  • Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        Select Case Target.Address
            Case Cells.Address
               MsgBox "Все ячейки листа"
            Case Target.EntireRow.Address
               MsgBox "Вся строка целиком"
            Case Target.EntireColumn.Address
               MsgBox "Весь столбец целиком"
        End Select
    End Sub
    Обратите внимание, на то, что данный код предназначен для работы со смежными диапазонами. Если же Вы хотите узнать что было выделено, например, с помощью клавиши CTRL, то имейте ввиду, что событие выполняется после каждого выделения. А значит и информацию Вы будете получать по мере выделения каждого несмежного диапазона.
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        For Each Target In Target.Areas
            Select Case Target.Address
                Case Cells.Address
                   MsgBox "Все ячейки листа"
                Case Target.EntireRow.Address
                   MsgBox "Вся строка целиком"
                Case Target.EntireColumn.Address
                   MsgBox "Весь столбец целиком"
            End Select
        Next
    End Sub
    Примечание : При желании можно не дёргать Cells.Address при каждом вызове события, а указать количество ячеек в виде константы, т.е. Case "$1:$65536", "$1:$1048576"
    Воспроизведение любых опубликованных здесь материалов возможно только с письменного разрешения автора : Microsoft Excel 95, 97, 2000, XP

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