Получить окно сообщения при двойном щелчке по ячейке - PullRequest
Новая
       37

Получить окно сообщения при двойном щелчке по ячейке

0 голосов
/ 11 мая 2018

У меня есть файл, в котором я хочу определить пару диапазонов, сохранить их в массиве и применить некоторые модификации к определенным группам внутри этого массива (или ко всему массиву). Все в приведенном ниже коде работает гладко (даже если могут быть некоторые ненужные объявления, но это моя вина); но я хотел бы добавить, что в «Выбор дела» за первые три месяца года, некоторые строки кода, которые позволили бы как-то «защитить» клетки, примерно так:

"Если ( нужен код для этого ): дважды щелкните или нажмите F2 в любой данной ячейке определенного массива (с целью вставки информации в эту ячейку). Затем

MsgBox "Вы не можете добавить информацию об этой конкретной ячейке вручную"

End If "

Идея состоит в том, чтобы впоследствии создать несколько кнопок, которые будут открывать поля вставки - и значения, вставленные в эти поля, будут впоследствии регистрироваться в ячейках, никогда не позволяя писать «вручную».

Если бы кто-то мог помочь мне с этим, я был бы благодарен! Заранее спасибо! 

Sub Structure4()

Application.Workbooks("Book1").Activate

Dim arr As Variant
arr = Array("A6:C105", "I6:AM105", "AN6:AN105", "AO6:AO105", "AP6:AP105", "AQ6:AQ105", "AR6:AR105", "AS6:AS105", "AT6:AT105", "AU6:AU105", "AV6:AV105", "AW6:AW105", "AX6:AX105", "AY6:AY105", "AZ6:AZ105", "BA6:BA105", "BB6:BB105", "BC6:BG105", "BH6:BH105", "BI6:BL105")

Dim wb As Workbook
Set wb = Application.Workbooks("Book1")

Dim ws As Worksheet
Dim i As Integer

For Each ws In wb.Sheets
    Select Case ws.name
    Case "January", "February", "March"
        With ws
            ws.Select
            For i = 0 To 19
                With .Range(arr(i))
                    .Font.name = "Arial Unicode MS"
                    .Font.Size = 8
                    .HorizontalAlignment = xlCenter
                End With
                Select Case i
                    Case 0, 1, 3, 5, 7, 9, 11, 13, 15, 16, 17
                        .Range(arr(i)).NumberFormat = "0.0;[Red]0.0"
                End Select
            Next
        End With
    End Select
Next ws

End Sub

1 Ответ

0 голосов
/ 11 мая 2018

поместите следующий код в область кода рабочей таблицы: 

Option Explicit

Dim rng As Range
Dim val As Variant
Dim arrRng As Range

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(arrRng, Target) Is Nothing Then
        MsgBox "You can't add information manually on this specific cell"
        Cancel = True
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(arrRng, Target) Is Nothing Then
        If Target.Address = rng.Address Then
            If Target.Value <> val Then
                MsgBox "You can't add information manually on this specific cell"
                Application.EnableEvents = False
                Target.Value = val
                Application.EnableEvents = True
            End If
        End If
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Set arrRng = Range("A6:C105, I6:AM105, AN6:AN105, AO6:AO105, AP6:AP105, AQ6:AQ105, AR6:AR105, AS6:AS105, AT6:AT105, AU6:AU105, AV6:AV105, AW6:AW105, AX6:AX105, AY6:AY105, AZ6:AZ105, BA6:BA105, BB6:BB105, BC6:BG105, BH6:BH105, BI6:BL105")

    If Not Intersect(arrRng, Target) Is Nothing Then
        If Target.Count = 1 Then
            Set rng = Target
            val = Target.Value
        End If
    End If
End Sub
...