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

[JohnSUN]

Будет макрос! Обязательно будет! Но попозже... Просто увлекся оформлением вот этой книжки (см. в приложении) и макрос пока отложил... и даже на форум не заглядывал... Потому не сразу увидел, что ты наотрез отказываешься от "не программного" заполнения...

Ты уж прости меня за упрямство навязчивость настойчивость - посмотри это решение и еще раз подумай, ладно? Имей в виду, эти два варианта - далеко не единственные! А то что это я в самом деле? Прошу подумать, а над чем подумать - не показываю...

А сейчас сорри - труба зовёт, должен убегать...

[вложение удалено Администратором]

[JohnSUN]

Апну тему, чтобы топикстартер не подумал, что о нем забыли.
Так, на чем мы остановились? Ага, у нас есть основная процедура из 14 строк и процитированная из книжки Питоньяка функция для определения типа документа:

Код:

REM  *****  BASIC  *****
Option Explicit ' Это означает, что каждая переменная должна быть описана с помощью инструкции Dim.

REM Author: Владислав Орлов aka JohnSUN, Киев, Украина, 2011

REM Макрос копирования выделенных данных
REM в новую строку листа с именем Прайс1
REM Для каждой выделенной в момент запуска
REM макроса ячейки и трех соседних с ней (справа)
REM копирует содержимое в лист с именем Прайс1
REM в столбец C в первую пустую строку
REM Первой целевой клеткой является C2.
Sub CopyDataToPrice1()
Dim oDoc As Object ' Текущий документ
Dim oSheets As Object ' Все листы нашего документа
Const shName = "Прайс1" ' Если потребуется сменить имя листа — меняем в этом месте
Dim oTargetSheet As Object ' Лист-цель с именем shName, куда копируем
oDoc = ThisComponent
If GetDocumentType(oDoc) <> "scalc" Then Exit Sub ' Eсли не из Калка запустили, то ничего не делать
oSheets = oDoc.getSheets()
REM Попытаться получить лист с именем shName:
If NOT oSheets.hasByName(shName) Then
print "Где-то потерялся " & shName & "!"
Exit Sub
End If
oTargetSheet = oSheets.getByName(shName)
REM Теперь нужно отыскать что сейчас выделено
REM На листе oTargetSheet найти последнюю заполненную строку
REM И где-то здесь будет предложенная convas строка насчет
REM Sheet2.copyRange (CellAddress, CellRangeAddress)
End Sub


REM Цитата из книжки Питоньяка Listing 4.1: Identify most OpenOffice.org document types.
REM Функция определяет тип документа, ссылка
REM на который передается параметром oDoc
REM и возвращает текстовое название этого типа
'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

Продолжаем разговор... (с) Карлсон
Или уже можно не продолжать, тема отпала?..  lyolikfx, макрос продолжаем писать? Или уже можно чем-то другим заняться?

[lyolikfx]

Добрый день. Я сейчас опробую даный екземпляр. Но если он не полный, то мне он по преджнему нужен.

[lyolikfx]

Исходя из кода, я так понял, нужно подписать лист2 ?

[JohnSUN]

Нет, далеко не полный! Можно и не пробовать! Это "заготовка, которую еще нужно обточить надфилем согласно эскиза" 

П

Исходя из кода, я так понял, нужно подписать лист2 ?

Почему 2? Ты же итоговый прайс держишь на "лист1"? Ну, в общем, куда копируем - тот и переименовываем...

А "безмакросный" вариант никак не прокомментируешь?

[lyolikfx]

Дело в том, что мне нужен динамический вариант формирования прайсов. Копировал-не то- удалил - добавил - отправил....
С макросом в МС офис очень удобно, но МС Офис отходит в историю, т.к. дядюшка Билл несколько зажрался. Приходится использовать безплатное ПО.

[lyolikfx]

Н да, смотрю код - тёмный лес. Честь вам и слава энтузиастам-альтруистам.

[JohnSUN]

мне нужен динамический вариант формирования прайсов. Копировал-не то- удалил - добавил - отправил....

Ну так лист Прайс2 чем плох? Проставил на исходных в колонке НУЖЕН! цифирки напротив позиций "отправим вот это", скопировал Прайс2 - да и отправил...

[lyolikfx]

мне нужен динамический вариант формирования прайсов. Копировал-не то- удалил - добавил - отправил....

Ну так лист Прайс2 чем плох? Проставил на исходных в колонке НУЖЕН! цифирки напротив позиций "отправим вот это", скопировал Прайс2 - да и отправил...

А можно пошагово?
А то вариант Копировать весь лист - отфильтровать - отправить -------- очень не удобный. Там 2500-3000 позиций начинаеш сверху и вниз, а потом данные изменились, возвращатся искать так неудобно.

[lyolikfx]

И ещё, если всё-же  рассматривать вариант с макросом, в ОпенОфис прописывается выполнение макроса на комбинацию клавиш или нажатие (созданной) кнопки?

[Рыбка Рио]

Да, в меню Сервис/Настройка- вкладка Клавиатура.

[вложение удалено Администратором]

[Рыбка Рио]

Одной строчкой можно так скопировать:

Код:

Sub Main
ThisComponent.Sheets.getByName("Лист2").getCellRangeByName("A1:B2").setDataArray(ThisComponent.CurrentSelection.DataArray)
End Sub

Но нужно выделить область размером 2х2 (чтобы она соответствовала "A1:B2")
Либо можно жетско задать то что вы собираетесь копировать:

Код:

Sub Main
ThisComponent.Sheets.getByName("Лист2").getCellRangeByName("B1:C2").setDataArray(ThisComponent.Sheets.getByName("Лист1").getCellRangeByName("A1:B2").DataArray)
End Sub

[вложение удалено Администратором]

[JohnSUN]

А можно пошагово?

1. Идем на лист Исходные.
2. Если будем готовить совершенно новый прайс, очистим колонку Е (становимся на E2; жмем Ctrl+Shift+End - выделены ячейки до конца листа; не отпуская Shift - несколько раз стрелку влево, чтобы остался выделенным один столбец; жмем Del - все ячейки очищены, в Прайс2 остался только заголовок "Артикул-Наименование-Наличие-Цена")
3. Просматриваем список товаров, напротив нужных в итоговом прайсе позиций жмем 1 (или 2, или 3... любую цифру) и Enter - в клетке появляется "птичка", а рядом, в столбце F - номер.
4. Если "птичка" стоит напротив ненужного товара - жмем Del: "птичка" и номер строки исчезают.
5. В любой момент переключаемся на Прайс2, проверяем готовность...
6. Для получения окончательного варианта переключаемся на Прайс2, жмем Ctrl+Home и Ctrl+Shift+End - выделены ячейки до конца заполненной части листа (можно и Ctrl+A, но тогда выделится весь лист, больше миллиона строк). Жмем Ctrl+C - скопировали. Жмем Ctrl+N - создали новую пустую книгу. Жмем Ctrl+Shift+V - Вставить как... (типа, "специальная вставка"), выставляем флажки как на рисунке, ОК.
7. Сохраняем с нужным именем или выгружаем в PDF.

А то вариант Копировать весь лист - отфильтровать - отправить -------- очень не удобный.

Конечно неудобный! А кто такой вариант предложил?

Там 2500-3000 позиций начинаеш сверху и вниз, а потом данные изменились, возвращатся искать так неудобно.

Не понял насчет "а потом данные изменились"... Когда изменились и с какого перепугу?

[вложение удалено Администратором]

[convas]

Одной строчкой можно так скопировать:
...
Либо можно жетско задать то что вы собираетесь копировать:

1. По условию задачи, требуется исходное выделение еще и растянуть до 4 ячеек.
2. Вставлять после (ниже) уже заполненных ранее ячеек.

В этом большая часть трудностей.

[lyolikfx]

Sub MainThisComponent.Sheets.getByName("Лист2").getCellRangeByName("B1:C2").setDataArray(ThisComponent.Sheets.getByName("Лист1").getCellRangeByName("A1:B2").DataArray)End Sub

О, спасибо Клио, теперь мы уже ближе. Но ещё не всё, может всем миром сейчас и разрешим задачу.