Excel макрос координаты ячейки

На мой взгляд, если рисовать между ячейками линию с помощью  

  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 намного удобнее, чем на портале сервиса, а для загрузки в сервис достаточно сформировать несложный файл. Заполнил новые строки, выделил их по любому столбцу, нажал кнопку и файл готов.


Координаты ячеек с числами

Werwolfik

Дата: Четверг, 18.01.2018, 05:24 |
Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 41


Репутация:

0

±

Замечаний:
0% ±


Excel 2013

День добрый.
помогите новичку.
В книге Ексель — находятся несколько ячеек с разными числами.
Рядом — таблички, где в ячейки I4, L4, O4 — представлены числа -по которым должен осуществляться поиск.

Как макросом — определить координаты ячеек с числами (представленными в I4, L4, O4) и выписать эти координаты в соответствующие таблицы?

К сообщению приложен файл:

7952819.xlsm
(10.6 Kb)

Сообщение отредактировал WerwolfikЧетверг, 18.01.2018, 05:25

 

Ответить

nilem

Дата: Четверг, 18.01.2018, 06:26 |
Сообщение № 2

Группа: Авторы

Ранг: Старожил

Сообщений: 1612


Репутация:

563

±

Замечаний:
0% ±


Excel 2013, 2016

Werwolfik, привет
попробуйте так
[vba]

Код

Sub ertert()
Dim v, adr$, r As Range

With Range(«A:H»)
    For Each v In Array(«I4», «L4», «O4»)
        Set r = .Find(Range(v).Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not r Is Nothing Then
            adr = r.Address
            Do
                Cells(Rows.Count, Range(v).Column).End(xlUp)(2, 1).Resize(, 2).Value = _
                Array(r.Left, r.Top)
                Set r = .FindNext(r)
            Loop While r.Address <> adr
        End If
    Next v
End With
End Sub

[/vba]


Яндекс.Деньги 4100159601573

 

Ответить

Werwolfik

Дата: Четверг, 18.01.2018, 07:36 |
Сообщение № 3

Группа: Пользователи

Ранг: Новичок

Сообщений: 41


Репутация:

0

±

Замечаний:
0% ±


Excel 2013

nilem, спасибо.

 

Ответить

Понравилась статья? Поделить с друзьями:
  • Excel макрос количество строк в таблице
  • Excel макрос количество листов
  • Excel макрос кнопка на панели
  • Excel макрос кнопка запуска макроса
  • Excel макрос как удалить всю строку