На мой взгляд, если рисовать между ячейками линию с помощью
ActiveSheet.Shapes.AddLine(x1, y1, x2, y2).Select
то логичнее меджу ними нарисовать границу, которая привязана к ячейкам.
Ведь как бы мы не изменяли размеры ячеек граница всегда будет привязана к ячейкам, хотя линия тоже может быть привязана, если в свойствах формат объекта задать перемещать и изменять объект вместе с ячейками.
Что такое координаты ячейки? На мой взгляд это какое-то вымышленное понятие, ведь в Excel они не задаются линейными размерами, например милиметрами, дюймами, points, pixel и т.п.
Например, высота строки измеряется в линейных размерах, т.е. points (pt),
а вот ширина столбца измеряется средним количеством знаков от 0 до 9 для установленного по умолчанию стандартного шрифта( например Arial 10). И это вносит свои сложности.
Вот приведу, как я нарисовал рамку с помощью метода границ (недостаток, что код громоздким получается)
Sub Рамка()
Range(«B1:AH61»).Select
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
End Sub
Конечно рамку можно нарисовать с помощью ActiveSheet.Shapes.AddLine(x1, y1, x2, y2).Select или BuildFreeform и код будет короче выглядеть,
но если рисовать линию между ячейками границами будет выглядеть логичнее.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 |
Option Explicit Sub PictureToCell(Nstrok As Long, Nstolb As Integer, _ ByVal name_of_Sheet As String, ByVal name_of_File As String) ''Накладывает' рисунок из файла 'name_of_File' на центр ячейки Cells(Nstrok, Nstolb) Dim i As Long, j As Integer Dim X As Double, Y As Double, CellsHeight As Double, CellsWidth As Double With ThisWorkbook.Sheets(name_of_Sheet) '________________________________________________ 'Проверка, явлеется ли ячейка частью объединённой If .Cells(Nstrok, Nstolb).MergeCells = True Then '________________________________________________ Dim strTmp As String, strTmp1 As String, Nstrok1 As String, _ Nstolb1 As String '________________________________________________________________________ 'Определение границ объединённой ячейки (номеров строк и столбцов) strTmp = .Cells(Nstrok, Nstolb).MergeArea.Address(ReferenceStyle:=xlR1C1) strTmp1 = Mid(strTmp, 2, InStr(1, strTmp, ':') - 2) Nstrok = Left(strTmp1, InStr(1, strTmp1, 'C') - 1) Nstolb = Right(strTmp1, Len(strTmp1) - InStr(1, strTmp1, 'C')) Nstrok1 = Right(strTmp, Len(strTmp) - InStr(1, strTmp, ':') - 1) Nstrok1 = Left(Nstrok1, InStr(1, Nstrok1, 'C') - 1) Nstolb1 = Right(strTmp, Len(strTmp) - InStr(1, strTmp, ':')) Nstolb1 = Right(Nstolb1, Len(Nstolb1) - InStr(1, Nstolb1, 'C')) '_________________________________________________________________________ '______________________________________________ 'Определение размера объединённой ячейки For i = Nstrok To Nstrok1 CellsHeight = CellsHeight + .Rows(i).Height Next i For j = Nstolb To Nstolb1 CellsWidth = CellsWidth + .Columns(j).Width Next j '_______________________________________________ Else CellsWidth = .Columns(Nstolb).Width CellsHeight = .Rows(Nstrok).Height End If '_________________________________________________ 'Определение координат верхнего левого угла ячейки For i = 1 To Nstrok - 1 Y = Y + .Rows(i).Height Next i For j = 1 To Nstolb - 1 X = X + .Columns(j).Width Next j '_________________________________________________ '_________________________________________________________________________ 'Добавление на лист рисунка из файла без изменения размеров последнего Dim objPic As Shape Set objPic = .Shapes.AddPicture(name_of_File, True, True, X, Y, True, True) '_________________________________________________________________________ End With '__________________________________________________ 'Выделение картинки и её перемещение в центр ячейки objPic.Select With Selection .ShapeRange.IncrementLeft (CellsWidth - .Width) / 2 .ShapeRange.IncrementTop (CellsHeight - .Height) / 2 End With '__________________________________________________ End Sub |
Как определить адрес активной ячейки.
Q: Как в макросе узнать и использовать текущее положение курсора (не мышиного, естественно)?
A:Очень просто! ActiveCell.Row и ActiveCell.Column — покажут координаты активной ячейки.
[ Назад ]
[ Оглавление ]
[ Далее ]
Оставить комментарий
Комментарий:
можно использовать BB-коды Максимальная длина комментария — 4000 символов. |
|
|
Комментарии
1.
17 апреля 2013, 22:49:22
Спасибо, освежило память))
2.
64K
28 сентября 2010 года
Vladlen70
0 / / 28.09.2010
28 сентября 2010, 16:25:13
А не проще ли использовать — ActiveCell.Address или Activecell.AddressLocal?
Определение адреса выделенного диапазона ячеек на листе Excel с помощью кода VBA. Определение номера первой и последней строки. Программное выделение диапазона.
Адрес выделенного диапазона
Для определения адреса выделенного диапазона ячеек в VBA Excel используется свойство Address объекта Selection.
Объект Selection — это совокупность всех выделенных ячеек на листе Excel. Это может быть одна ячейка, смежный или несмежный диапазон ячеек, представляющий коллекцию смежных диапазонов. Если выделение состоит из несмежного диапазона, адреса смежных диапазонов, из которых он состоит, будут перечислены через запятую.
Смежный диапазон — прямоугольная область смежных (прилегающих друг к другу) ячеек.
Несмежный диапазон — совокупность (коллекция) смежных диапазонов (прямоугольных областей смежных ячеек).
Стоит отметить: несмотря на то, что в выделенном диапазоне может содержаться много ячеек, активной может быть только одна. Она представлена объектом ActiveCell. Для определения ее адреса в коде VBA Excel также используется свойство Address.
Sub Primer1() MsgBox «Адрес выделенного диапазона: « & Selection.Address & _ vbNewLine & «Адрес активной ячейки: « & ActiveCell.Address & _ vbNewLine & «Номер строки активной ячейки: « & ActiveCell.Row & _ vbNewLine & «Номер столбца активной ячейки: « & ActiveCell.Column End Sub |
Скопируйте и запустите код на выполнение. В результате получите что-то вроде этого, зависящее от того, какие диапазоны вы выберите:
Определение адресов выделенного диапазона и активной ячейки
Выделение ячеек и диапазонов
Выделить несмежный диапазон ячеек можно следующим образом:
Sub Primer2() Range(«B4:C7,E5:F7,D8»).Select End Sub |
Как видно из примера, в адресной строке объекта Range перечисляются адреса смежных диапазонов, составляющих общий несмежный диапазон, через запятую. Выделение осуществляется методом Select объекта Range.
Определение номеров первой и последней строки
Чтобы вычислить номера первой и последней строки выделенного диапазона, будем исходить из того, что первая ячейка смежного диапазона находится на первой строке, а последняя — на последней строке выделенного диапазона.
Sub Primer3() Dim i1 As Long, i2 As Long i1 = Selection.Cells(1).Row i2 = Selection.Cells(Selection.Cells.Count).Row MsgBox «Первая строка: « & i1 & _ vbNewLine & «Последняя строка: « & i2 End Sub |
Результат будет таким, зависит от выделенного диапазона:
Номера первой и последней строки выделенного смежного диапазона
Таким же образом можно вычислить номера первого и последнего столбцов выделенного диапазона, которые можно использовать для обработки информации по столбцам.
Обратите внимание, что для несмежных диапазонов этот пример не работает.
На практике я использовал определение номеров первой и последней строк по выделенному диапазону для формирования файла загрузки данных держателей дисконтных карт на сервис отправки СМС-сообщений. Оказалось, что базу данных клиентов заполнять в таблице Excel намного удобнее, чем на портале сервиса, а для загрузки в сервис достаточно сформировать несложный файл. Заполнил новые строки, выделил их по любому столбцу, нажал кнопку и файл готов.
Координаты ячеек с числами |
||||||||
Ответить |
||||||||
Ответить |
||||||||
Ответить |