Sub ЗапускФайла() If ActiveWorkbook.Sheets("Лист1").Range("E12").Value <> Format(Now, "dd.mm.yyyy") Then Call Макрос1 ActiveWorkbook.Sheets("Лист1").Range("E12").Value = Format(Now, "dd.mm.yyyy") End IfEnd Sub
Sub ИмяЛиста() Sheets("Лист1").Copy Before:=Sheets(2) ActiveSheet.Name = Format(Now, "dd.mm.yyyy")End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)Dim arrM()Dim A As IntegerarrM = Array("~?~", "ю", "б", "/", "\")If Not Intersect(Target, Union(Range("K11:K28"), Range("Q11:Q28"))) Is Nothing ThenWith Range("K11")For A = LBound(arrM) To UBound(arrM).Replace arrM(A), ".".NumberFormat = "General".Value = .ValueNextEnd WithEnd Sub
Sub Макрос1()Static Tr As BooleanIf Tr <> True ThenTr = TrueElseTr = FalseEnd IfRange("A1") = TrEnd Sub
Sub Макрос1()Dim MyComentText As StringMyComentText = "Ошибка! Введены неверные данные"If IsNumeric(Range("A1")) = False ThenWith Range("A1")If (.Comment Is Nothing) Then.AddComment.Text MyComentTextEnd IfEnd WithElseRange("A1").ClearCommentsEnd IfEnd Sub
Sub Макрос1()If IsNumeric(Range("A1")) = False ThenRange("A1").ClearContentsEnd IfEnd Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)Dim arrM()Dim A As IntegerStatic Tr As BooleanStatic Itr As Integer, Jtr As Integer, Ifl As Integer, Jfl As IntegerDim i As Integer, j As IntegerDim MyComentText As StringDim Rz As RangeSet Rz = SelectionMyComentText = "Ошибка! Вы ввели текст.Укажите верное числовое значение"arrM = Array("~?~", "ю", "б", "/", "\", "ж", "э", ">", "<")If Not Intersect(Target, Union(Range("K11:K28"), Range("Q11:Q28"), Range("A1"))) Is Nothing ThenIf Tr <> True ThenTr = TrueElseTr = FalseEnd IfIf Tr = True ThenItr = Rz.RowJtr = Rz.ColumnIf Itr = 1 And Jtr = 1 Theni = Itrj = JtrElsei = Iflj = JflEnd IfEnd IfIf Tr = False ThenIfl = Rz.RowJfl = Rz.Columni = Itrj = JtrEnd IfOn Error Resume NextWith Cells(i, j).ClearCommentsFor A = LBound(arrM) To UBound(arrM).Replace arrM(A), ".".NumberFormat = "General".Value = .ValueNextEnd WithIf IsNumeric(Cells(i, j)) = False ThenWith Cells(i, j)If (.Comment Is Nothing) Then.AddComment.Text MyComentTextElse.Comment.Text MyComentTextEnd If.Select.ClearContentsEnd WithEnd IfEnd IfEnd Sub