Копировать с помощью макроса на другой лист

[lyolikfx]

Здравствуйте господа. Перерыл кучу форумов, вообщем сам не разобрался. И так к делу.
Мне нужна функция макроса для копирования содержимого из выделеной (выбраной) ячейки + соседних одной или двух(справа) с одного листа на другой лист. При чём, чтоб на втором листе функция сама определяла если первоначальная ячейка занята то копировать в первую свободную снизу.
В майкрософт офис она выглядит так
Sub Test()
 Selection.Resize(, 4).Copy Worksheets("лист1").Columns(3).Cells(Worksheets("лист1").Rows.Count).End(xlUp).Offset(1)
End Sub

Помогите люди добрые кто чем может. Подскажите как её сделать.

[JohnSUN]

Добро пожаловать на форум!

Сразу хочу предупредить: VBA и StaBasic хотя и очень похожи по внешнему виду синтаксиса - совершенно разные по сути. То что делается в VBA одной, пусть и очень длинной строкой, в StaBasic'е иногда потребует несколько строк. А люди говорят, иногда - и наоборот: одну строчку на StaBasic'е невозможно правильно перевести на VBA не наваяв тридцать строк кода. О примере такого перевода не проси, сам не видел,  изобретать лень.

Сразу разберем твой Sub Test(): "Растянуть выделение на четыре клетки вправо. На листе "лист1" этой же книги найти в третьей колонке последнюю заполненную ячейку и сдвинутся еще на одну ячейку ниже. Вставить сюда то, что выделено вначале".
Не стану докапываться к возможным ошибкам при выполнении этого макроса - тест он и есть тест. Но тем не менее не смотря на то, что эта процедура в большинстве случаев работает нормально, возможны варианты, когда этот код будет глючить. Например, если мы выделим на «лист1» несколько клеток в конце уже получившегося списка и еще несколько ячеек (пустых) ниже, то макрос скопирует не то что выделялось,  то что в этих клетках появилось по ходу выполнения, дубли пойдут. Или если выделение будет не одной клеткой и не диапазоном клеток, а группой диапазонов (с зажатым Ctrl обвести мышкой несколько не связанных прямоугольников) — макрос вообще заткнётся с сообщением об ошибке 1004.
Это одно из основных различий этих двух языков программирования: VBA кидается выполнять код, что бы там ни понаписывали, а при написании макроса на StaBasic приходится долго и нудно выписывать заранее все необходимые проверки )зато потом макрос практически не глючит). Вот из-за этих проверок и тщательной подготовки данных код на Бэйсике и становится большим.

Ты говорил, что "I need this macros very much." И я так понял — срочно.
Поэтому не стану прямо сейчас грузить теорией, а начнем ваять нужный тебе код.
Начало и конец процедуры как в VBA:

Код Выделить Развернуть

Sub Test()
REM Сюда надергаем цитат из листингов Питоньяка или сами чего-нибудь напишем
End Sub

Если VBA всегда предполагает что работает с одним вот этим вот документом из которого запущен макрос, то ему и не требуется пальцем тыкать возьми из вон того WorkBook'а. В Ооо чуть иначе всё устроено, здесь все документы под рукой. С одной стороны удобно, между разными документами из одного макроса скачешь и горя не знаешь. Но из-за этого каждый раз нужно указывать какой из документов имеется в виду в данном случае. Поэтому первые строчки

Код Выделить Развернуть

Dim oDoc
oDoc = ThisComponent

Описывать переменные принудительно не обязательно. Но если в начале модуля стоит Option Explicit без Dim для каждой используемой переменной макрос просто не запустится. Поэтому лучше всегда описывать.
Текущим документом может оказаться любой. В смысле, этот макрос можно запустить из листа Райтера, у которого нету Sheet, Cell и прочих вещей, которые нам понадобятся для решения задачи. Значит дальше идёт первая проверка – а из Калковской ли книги макрос запустили?
Копипастим из книжки Питоньяка Listing 4.1: Identify most OpenOffice.org document types.

Код Выделить Развернуть

'Author: Included with OpenOffice
'Modified by Andrew Pitonyak
Function GetDocumentType(oDoc)
  Dim sImpress$
  Dim sCalc$
  Dim sDraw$
  Dim sBase$
  Dim sMath$
  Dim sWrite$

  sCalc    = "com.sun.star.sheet.SpreadsheetDocument"
  sImpress = "com.sun.star.presentation.PresentationDocument"
  sDraw    = "com.sun.star.drawing.DrawingDocument"
  sBase    = "com.sun.star.sdb.DatabaseDocument"
  sMath    = "com.sun.star.formula.FormulaProperties"
  sWrite   = "com.sun.star.text.TextDocument"

  On Local Error GoTo NODOCUMENTTYPE
  If oDoc.SupportsService(sCalc) Then
    GetDocumentType() = "scalc"
  ElseIf  oDoc.SupportsService(sWrite) Then
    GetDocumentType() = "swriter"
  ElseIf  oDoc.SupportsService(sDraw) Then
    GetDocumentType() = "sdraw"
  ElseIf  oDoc.SupportsService(sMath) Then
    GetDocumentType() = "smath"
  ElseIf  oDoc.SupportsService(sImpress) Then
GetDocumentType() = "simpress"
  ElseIf  oDoc.SupportsService(sBase) Then
    GetDocumentType() = "sbase"
  End If
  NODOCUMENTTYPE:
  If Err <> 0 Then
    GetDocumentType = ""
    Resume GOON
    GOON:
  End If
End Function
Вставляем его после нашей End Sub
А в коде добавляем строку

Код Выделить Развернуть

If GetDocumentType(oDoc) <> "scalc" Then Exit Sub
Ну, в том смысле, что если не из Калка запустили, то ничего и не делать.

[convas]

Мне нужна функция макроса для копирования содержимого из выделеной (выбраной) ячейки + соседних одной или двух(справа) с одного листа на другой лист

По смыслу, одной ячейки.

JohnSUN, что-то ты перемудрил, по моему.

Вот примерная заготовка:

Код Выделить Развернуть

sub CopyCellRange

  Dim Sheet As Object
  Dim CellRange As Object
 
  Dim CellRangeAddress As New com.sun.star.table.CellRangeAddress
  Dim CellAddress As New com.sun.star.table.CellAddress

  oDocument=ThisComponent

  Sheet = oDocument.Sheets(0)
  Sheet2 = oDocument.Sheets(1)

'source range
  CellRange = oDocument.getCurrentSelection()
  CellRangeAddress = CellRange.getRangeAddress

''' !!! здесь нужно CellRangeAddress еще растянуть до 4 ячеек справа
''' !!! ...........................................

'target range
  CellAddress.Sheet = 1
 
  CellAddress.Column = 2
 
''' !!! здесь нужно еще найти последнюю занятую строку в первой из колонок, куда копируется ("С", т.к. Worksheets("Лист2").Columns(3) )
''' !!! см. Питоньяк
''' !!! ...........................................
''' !!! RowLast=

  RowLast=-1         'пусть пока нет занятых строк
 
  CellAddress.Row = RowLast+1

  'copying range
  Sheet2.copyRange (CellAddress, CellRangeAddress)
end sub


PS. В сообщении lyolikfx ошибка, должно быть так:

Selection.Resize(, 4).Copy Worksheets("Лист2").Columns(3).Cells(Worksheets("Ëèñò1").Rows.Count).End(xlUp).Offset(1)

[JohnSUN]

Вот примерная заготовка:

Код Выделить Развернуть

sub CopyCellRange
=== Здесь я кусок цитаты чикнул ===
''' !!! здесь нужно еще найти последнюю занятую строку в первой из колонок, куда копируется ("С", т.к. Worksheets("Лист2").Columns(3) )
''' !!! см. Питоньяк
''' !!! ...........................................
''' !!! RowLast=


Я к этому и веду! Функция Johnny Rosenberg у Питоньяка в 6.22. Which cells are used in a sheet?

Код Выделить Развернуть

Function GetLastUsedRow(oSheet) As Integer
  Dim oCursor
  oCursor = oSheet.createCursor
  oCursor.GotoEndOfUsedArea(True)
  GetLastUsedRow = oCursor.RangeAddress.EndRow
End Function

Работает отлично, но я до неё просто еще не добрался. По-чесноку, я вообще-то еще даже до выделенного фрагмента не добрался. Но уже скоро! (Еще бы в Аську больше никто со своим "превед-кагдила" не лез    )

PS. В сообщении lyolikfx ошибка, должно быть так:

Selection.Resize(, 4).Copy Worksheets("Лист2").Columns(3).Cells(Worksheets("Ëèñò1").Rows.Count).End(xlUp).Offset(1)

Ну, вообще-то, ИМХО, там действительно первый лист, просто должен быть упомянут дважды... Не "Ëèñò1" (дальше по строке), а "Лист1".
А то получится, что последнюю ячейку ищем на листе1, а пишем в соответствующую ячейку листа2...
И кстати! Ты откуда строку цитировал? В топикстарте никаких Ëèñò1 не было, это ты откуда-то из другого места взял... Или у тебя браузер хамит...

lyolikfx, ты не молчи, ты участвуй... А то мы с convas сейчас подерёмся, а потом окажется, что мы с ним совсем не то пишем... С какого листа нужно копировать, на какой... И - кстати! - по какому признаку ты клетки для копирования выделяешь? Может их и выделять не надо, а прямо макросом найти?

[lyolikfx]

Добрый день ещё раз. Всем нам хватит земли... этой обетованной, желанной.... )
А теперь к делу, этот макрос
Sub Test()
  Selection.Resize(, 4).Copy Worksheets("Лист1").Columns(3).Cells(Worksheets("Лист1").Rows.Count).End(x1Up).Offset(1)
End Sub
реально работающий. Я его использую в МС Офис для формирования прайсов (его тоже мне помогли на форумах наваять). Смысл его в том, что выбираю ячейку выполняю макрос и результат - копируется содержимое данной ячейки и ещё 3-х (4-х) соседних на лист1. А на листе1 создаётся нужный мне список.
Вот, теперь я ищу помощи кто-б помог написать такого типа макрос но для ОПЕНОФИСА.
Буду очень признателен, я знаете, в програмировании очень-очень поверхносно...
Заранее спасибо.

[lyolikfx]

и ещё по поводу
Sub Test()
  Selection.Resize(, 4).Copy Worksheets("Ëèñò1").Columns(3).Cells(Worksheets("Ëèñò1").Rows.Count).End(xlUp).Offset(1)
End Sub
Первоначальная ячейка на листе1 не А1, а С2, это так было задумано для удобства.

[convas]

Так с какого листа на какой копировать?

C "Лист1" на "Лист1", или c "Лист1" на "Лист2", или c "Лист2" на "Лист1"?

[JohnSUN]

О! Задача проясняется! Так это мы готовый прайс лепим? Тогда сразу уточнение... даже два... Нет, три!
1. В листе С КОТОРОГО забираем данные формулы есть? Ну там какой-нибудь =Курс*Цену или = Цена+Надбавка... На лист1 нам же нужно собрать уже названия-артикулы-еще_чего-то-цена без всяких формул, только значения?
2. Со скольких листов отбираются позиции? Я так понимаю, в книге два листа - лист1... (если честно, уже замучился с этим "лист1" - давай его прямо сейчас договоримся переименовать, например, в "Прайс"?) и второй, на котором полная товарная линейка... Отбираем каждый день (?!!) позиции, которые, допустим, есть на складе, копируем их на первый лист и уже его публикуем (печатаем, отсылаем). Так?
3. Ты не помнишь КАК вставлял код в прошлом и позапрошлом сообщениях? Оба раза копи-пастом? А то в позапрошлый раз нормальный Лист1, а в прошлый опять какой-то Ëèñò1...

(convas, так не честно! Это была моя реплика, я просто не успел спросить!)

[lyolikfx]

С листа который в данный момент открыт. Если для макроса надо подписать специально лист то ето не имеет значения подписать его не трудно.
Тот макрос в МС офис работал с любого открытого листа (насколько я понимаю значение имеет SELECTION).

[lyolikfx]

О! Задача проясняется! Так это мы готовый прайс лепим? Тогда сразу уточнение... даже два... Нет, три!
1. В листе С КОТОРОГО забираем данные формулы есть? Ну там какой-нибудь =Курс*Цену или = Цена+Надбавка... На лист1 нам же нужно собрать уже названия-артикулы-еще_чего-то-цена без всяких формул, только значения?
2. Со скольких листов отбираются позиции? Я так понимаю, в книге два листа - лист1... (если честно, уже замучился с этим "лист1" - давай его прямо сейчас договоримся переименовать, например, в "Прайс"?) и второй, на котором полная товарная линейка... Отбираем каждый день (?!!) позиции, которые, допустим, есть на складе, копируем их на первый лист и уже его публикуем (печатаем, отсылаем). Так?
3. Ты не помнишь КАК вставлял код в прошлом и позапрошлом сообщениях? Оба раза копи-пастом? А то в позапрошлый раз нормальный Лист1, а в прошлый опять какой-то Ëèñò1...

(convas, так не честно! Это была моя реплика, я просто не успел спросить!)

1. формул нет только значения
2. с одного (в нём(листе) целый список а мне надо выборочные позиции)
3. Ëèñò1 это ошибки, в реале лист1. но подписать можно как угодно

[JohnSUN]

Смысл его в том, что выбираю ячейку выполняю макрос и результат - копируется содержимое данной ячейки и ещё 3-х (4-х) соседних на лист1. А на листе1 создаётся нужный мне список.
Вот, теперь я ищу помощи кто-б помог написать такого типа макрос но для ОПЕНОФИСА.
Буду очень признателен, я знаете, в програмировании очень-очень поверхносно...

Я ж потому и спрашиваю! Тут ведь какая фишка - Калк умеет вытворять с данными "такое, что папа с мамой плакали навзрыд..." (тоже любишь Высоцкого?) Причем делает это на одних формулах и фильтрах, без макросов вообще. Так если тебе сложно во всей этой кухне разбираться, может, просто расскажешь полностью, что ты делаешь с данными и мы тут помозгуем, как это всё сделать попроще? Ну, через Данные-Фильтр-Стандартный фильтр, например...
Или второй вариант - шаг за шагом выписываем всё что нужно сделать с помощью макроса и по ходу дела ты из состояния "в програмировании очень-очень поверхносно" переходишь в состояние "ну, кому тут еще чего запрограммировать?"

С листа который в данный момент открыт. Если для макроса надо подписать специально лист то ето не имеет значения подписать его не трудно.
Тот макрос в МС офис работал с любого открытого листа (насколько я понимаю значение имеет SELECTION).

Так я об этом уже говорил - нечаянно запускаешь макрос стоя на готов прайсе и получаешь дубли позиций... И то если стоял в столбце С. А если в другом, так вообще торба

1. формул нет только значения
2. с одного (в нём(листе) целый список а мне надо выборочные позиции)
3. Ëèñò1 это ошибки, в реале лист1. но подписать можно как угодно

1. Это сильно облегчает задачу. А то пришлось бы дополнительно голову ломать
2. Так давай фильтром за один раз все нужные позиции выдернем! Не по одной штучке, а - хлоп! - прайс готов
3. Это-то я понимаю... Пытаюсь просто уловить закономерность. Иногда из Аськи в форум или из 1С в Аську копируешь - полная ахинея получается. А иногда всё тип-топ... Вот и хочу понять из-за чего бывает "тип-топ"

[lyolikfx]

  Высоцкий  это мой духовный отец.
Так что господа, поможете мне с макросом - то?

[JohnSUN]

Да легко! Сколько готов подождать?

И всё-таки подумай: а может ну его, этот макрос? В отдельной колонке пробежался, проставил какой-то значок... Ну там, единичку какую-то написал... Потом правой кнопкой щелкнул, выбрал Обновить данные - перешел на первый лист, а там уже всё готово... А то и вообще больше ничего не щелкаешь. Просто ставишь в нужном месте чего-нибудь или стираешь, а на первом листе прайс автоматом строки добавляет-удаляет

[lyolikfx]

Да легко! Сколько готов подождать?

И всё-таки подумай: а может ну его, этот макрос? В отдельной колонке пробежался, проставил какой-то значок... Ну там, единичку какую-то написал... Потом правой кнопкой щелкнул, выбрал Обновить данные - перешел на первый лист, а там уже всё готово... А то и вообще больше ничего не щелкаешь. Просто ставишь в нужном месте чего-нибудь или стираешь, а на первом листе прайс автоматом строки добавляет-удаляет

Не, мне нужен именно макрос, а когда сделаете это такое дело. Буду весьма признателен.

[lyolikfx]

А на счёт предложеного способа "обновить данные" можна поподробнее, он мне тож в одном деле пригодится.
всё, ненадо, тут я сам разобрался.