Форум поддержки пользователей. LibreOffice, Apache OpenOffice, OpenOffice.org

Форум поддержки пользователей. LibreOffice, Apache OpenOffice, OpenOffice.org

20 Июль 2019, 02:05 *
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
Вам не пришло письмо с кодом активации?

Войти
Новости: Доступно и просто о работе в офисных пакетах
 
   Начало   Помощь Поиск Войти Регистрация    задать вопрос  
Страниц: 1   Вниз
  Печать  
Автор Тема: Макрос для определения диапазона объединенных ячеек  (Прочитано 3872 раз)
0 Пользователей и 1 Гость смотрят эту тему.
dndn
Форумчанин
***
Offline Offline

Сообщений: 93



WWW
« Стартовое сообщение: 15 Июнь 2015, 13:54 »

Собственно сабж.  Непонимающий

Все, что приходит в голову - перебирать ячейки, проверяя на свойство IsMerged. Но оно решения не дает - следующая ячейка, участвующая в объединении, имеет свойство IsMerged как False...
« Последнее редактирование: 15 Июнь 2015, 14:36 от dndn » Записан
kompilainenn
Мастер
*****
Offline Offline

Сообщений: 2 683



« Ответ #1: 15 Июнь 2015, 14:45 »

а сама задача-то как звучит? может ее можно решить иначе?
Записан

Поддержать разработчиков LibreOffice можно тут, а наш форум вот тут
JohnSUN
Капитана в тот день называли на "ты"
Гуру
*******
Offline Offline

Пол: Мужской
Расположение: Киев
Сообщений: 2 764


Помогаю людям и компьютерам понимать друг друга


WWW
« Ответ #2: 15 Июнь 2015, 14:53 »

По найденной ячейке с IsMerged=True создаешь "курсор по диапазону" (createCursorByRange) и натравливаешь на него collapseToMergedArea
Записан

Владислав Орлов aka JohnSUN
Благодарить-не зазорно.
Подарить благо создателям офиса, нашему ресурсу, мне
dndn
Форумчанин
***
Offline Offline

Сообщений: 93



WWW
« Ответ #3: 15 Июнь 2015, 15:21 »

JohnSun, а можно пример с кодом, что-то я не могу курсор создать... Грустный
Записан
dndn
Форумчанин
***
Offline Offline

Сообщений: 93



WWW
« Ответ #4: 15 Июнь 2015, 15:28 »

а сама задача-то как звучит? может ее можно решить иначе?
задача так и звучит: если есть объединенные ячейки, то нужно узнать диапазон объединения.
Более широко - надо выделить диапазон ячеек, исследовать находящиеся в нем значения и форматирование элементов и из всего этого создать табличный бб-код для вставки в сообщение форума. Диапазон объединения в частности нужен для указания атрибутов colspan и rowspan.
Записан
JohnSUN
Капитана в тот день называли на "ты"
Гуру
*******
Offline Offline

Пол: Мужской
Расположение: Киев
Сообщений: 2 764


Помогаю людям и компьютерам понимать друг друга


WWW
« Ответ #5: 15 Июнь 2015, 16:26 »

Ну, если на скорую руку, просто для примера, то так:
Код:
Sub getAddrMergedCells
Dim oSheet As Variant
Dim oCursor As Variant
Dim oCellRangeByName As Variant
Dim nRowCount As Long
Dim nColCount As Long
Dim oCellByPosition As Variant
Dim oMergCursor As Variant
Dim i&, j&
Dim aData As Variant

oSheet = ThisComponent.getCurrentController().getActiveSheet() ' Можно и .getByIndex(чего-то там)... Это же только пример ;-)
oCursor = oSheet.createCursor() ' Это обычный курсор, просто чтобы определить занятое место
oCursor.gotoEndOfUsedArea(True)
If not oCursor.getIsMerged() Then
MsgBox("На этом листе (в заполненной области) объединенных ячеек не обнаружено...")
Exit Sub
EndIf

nRowCount = oCursor.getRows().getCount()-1
nColCount = oCursor.getColumns().getCount()-1
aData = Array()
REM Здесь, как ты и делал, перебираем ячейки по одной
For j = 0 To nRowCount
For i = 0 To nColCount
oCellByPosition = oSheet.getCellByPosition(i, j)
If oCellByPosition.getIsMerged() Then ' Если она из объединенных - слизываем адрес всей области
oMergCursor = oSheet.createCursorByRange(oCellByPosition)
oMergCursor.collapseToMergedArea()
getIndexOrAdd(oMergCursor.AbsoluteName, aData) ' Чтобы не повторяться, собираем уникальные строки
EndIf
Next i
Next j
MsgBox "Найдено " + (UBound(aData)+1) + " объединенных диапазонов" + Chr(10) + Join(aData, Chr(10))
End Sub

Function getIndexOrAdd(key, aData)
Dim l&, r&, m&, N&, i&
l=LBound(aData)
r=UBound(aData)+1
N=r
While (l<r)
m=l+Int((r-l)/2)
If aData(m)(0)<key Then
l=m+1
Else
r=m
EndIf
Wend
If r=N Then
ReDim Preserve aData(0 To N)
aData(N) = key
getIndexOrAdd = N
ElseIf  aData(r)=key Then
getIndexOrAdd = r
Else
ReDim Preserve aData(0 To N)
For i = N-1 To r Step -1
aData(i+1)=aData(i)
Next i
aData(r) = key
getIndexOrAdd = r
EndIf
End Function
Записан

Владислав Орлов aka JohnSUN
Благодарить-не зазорно.
Подарить благо создателям офиса, нашему ресурсу, мне
dndn
Форумчанин
***
Offline Offline

Сообщений: 93



WWW
« Ответ #6: 15 Июнь 2015, 16:51 »

JohnSUN, спасибо, буду разбираться!  Всё хорошо
Записан
Страниц: 1   Вверх
  Печать  
 
Перейти в:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2006-2009, Simple Machines Valid XHTML 1.0! Valid CSS!