Mishel917
Junior Member | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Для кнопки на листе.
Private Sub CommandButton1_Click()
Dim myCell As Range
Dim intA As Integer
Dim Titl As String
Dim Prompt As String
Set myCell = ActiveCell
For intJ = 5 To 1005
If myCell.Address(RowAbsolute:=False, ColumnAbsolute:=False) = Worksheets("Ëèñò1").Cells(intJ, 2).Address(RowAbsolute:=False, ColumnAbsolute:=False) Then
If myCell <> "" Then
ActiveSheet.Cells(intJ, 2).Font.Color = vbBlue
Prompt = "Вы выбрали - " & "строка " & intJ & " значение " & ActiveSheet.Cells(intJ, 2) & Chr(13) & Chr(10) & "Продолжать ?"
Titl = "Сообщение журнала реестрации"
intAns = MsgBox(Prompt, vbYesNoCancel, Titl)
If intAns = vbYes Then GoTo 10
ActiveSheet.Cells(intJ, 2).Font.Color = vbBlack
ActiveSheet.Cells(4, 7).Activate
Exit Sub
10 ActiveSheet.Cells(intJ, 2).Font.Color = vbBlack
For Each myCell In Selection
For intA = 5 To 1005
If myCell.Address(RowAbsolute:=False, ColumnAbsolute:=False) = Cells(intA, 2).Address(RowAbsolute:=False, ColumnAbsolute:=False) Then
Cells(intA, 2) = Cells(intA, 2) + 1
End If
Next intA
Next myCell
Exit Sub
End If
Prompt = "Выделите курсором мыши номер."
Titl = "Сообщение журнала реестрации"
intAns = MsgBox(Prompt, vbInformation, Titl)
Exit Sub
End If
Next intJ
Prompt = "Выделите курсором мыши номер."
Titl = "Сообщение журнала реестрации"
intAns = MsgBox(Prompt, vbInformation, Titl)
End Sub
Необходимо добавить ещё больше сервиса, на случай выделения диапазона.
|
