Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
mironov_gotovye_makrosy_v_vba_excel.doc
Скачиваний:
0
Добавлен:
01.07.2025
Размер:
1.41 Mб
Скачать

Размещение в ячейке электронных часов

Sub UpdateTime()

Dim varNextCall As Variant

' Записываем в ячейку текущее время

Cells(1, 1).Value = Now

' Записываем в varNextCall время, когда вызвать этот макрос _

в следующий раз (через 1 секунду)

varNextCall = TimeSerial(Hour(Now), Minute(Now), Second(Now) + 1)

' Уведомляем Excel в необходимости вызова макроса

Application.OnTime varNextCall, "UpdateTime"

End Sub

«Будильник»

Sub Clock()

' Уведомляем Excel, что процедуру Alarm нужно вызвать в 20:55

Application.OnTime TimeValue("20:55:00"), "Alarm"

End Sub

Sub Alarm()

MsgBox "Пора ужинать!!!"

End Sub

Оформление верхней и нижней границ диапазона

Sub RangeBorder()

Dim rgRange As Range

Set rgRange = Range("B2:D5")

' Оформление верхней границы диапазона

With rgRange.Borders(xlEdgeTop)

.Weight = xlThick

.LineStyle = xlContinuous

.Color = RGB(0, 0, 255)

End With

' Оформление нижней границы диапазона

With rgRange.Borders(xlEdgeBottom)

.Weight = xlMedium

.LineStyle = xlDash

.Color = RGB(255, 0, 255)

End With

End Sub

Адрес активной ячейки

Sub Worksheet_SelectionChange(ByVal Target As Range)

' Вывод адреса ячейки в различных форматах

MsgBox Target.Address() & vbCr & _

Target.Address(RowAbsolute:=False) & vbCr & _

Target.Address(ReferenceStyle:=xlR1C1) & vbCr & _

Target.Address(ReferenceStyle:=xlR1C1, _

RowAbsolute:=False, ColumnAbsolute:=False, _

RelativeTo:=Worksheets(1).Cells(2, 2))

End Sub

Координаты активной ячейки

ActiveCell.Row и ActiveCell.Column - покажут координаты активной ячейки.

Формула активной ячейки

s = Range("A3").Formula

Получение из ячейки формулы

Sub Test()

With Application.Workbooks.Item("Test.xls")

Worksheets("Лист2").Activate

Range("A2") = 2

Range("A3") = "=A2+2"

MsgBox Range("A3").Formula + " - " + Str(Range("A3").Value)

End With

End Sub

Тип данных ячейки

Function dhCellType(rgRange As Range) As String

' Переходим к левой верхней ячейке, если rgRange - диапазон, _

а не одна ячейка

Set rgRange = rgRange.Range("A1")

' Определение типа значения в ячейке

Select Case True

Case IsEmpty(rgRange)

' Ячейка пуста

dhCellType = "Пусто"

Case Application.IsText(rgRange)

' В ячейке текст

dhCellType = "Текст"

Case Application.IsLogical(rgRange)

' В ячейке логическое значение (True или False)

dhCellType = "Булево выражение"

Case Application.IsErr(rgRange)

' При вычислении значения в ячейке произошла ошибка

dhCellType = "Ошибка"

Case IsDate(rgRange)

' В ячейке дата

dhCellType = "Дата"

Case InStr(1, rgRange.Text, ":") <> 0

' В ячейке время

dhCellType = "Время"

Case IsNumeric(rgRange)

' В ячейке числовое значение

dhCellType = "Число"

End Select

End Function

Вывод адреса конца диапазона

Sub TestRange()

Dim r As Range

Set r = Range("rrrrr")

MsgBox (r.Columns.End(xlUp).Address)

MsgBox (r.Columns.End(xlDown).Address)

End Sub

Соседние файлы в предмете [НЕСОРТИРОВАННОЕ]