Переделать макрос для Excel под OOo

[Ninel]

Добрый день, друзья!
Побывала на форуме Инфра Ресурс, добрые люди перенаправили меня к вам.
Имеется прайс в формате .xls с макросом.
Мне теперь необходимо переписать его под ООо. Я понимаю, что макрос сам по себе несложный. Честно пыталась сама переписать, но увы. Какие-то кусочки мне удалось написать, много чего нового узнала, перешерстила оба форума.Мозги сломала, а результата нет. Начальство уже требует результат, а показать особо нечего.
Помогите, пожалуйста.

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

[neft]

Вопрос 1 (и главный):
Ваш (готовый) документ должен быть в формате XLS или ODS ?

Отвечать обязательно!

[Ninel]

Желательно в xls

[neft]

Желательно в xls

Это проблема!
Запустить (и даже сохранить) макрос в XLS, используя OpenOffice - нетривиальная задачка!

Решил запостить ваш исходный экселевский макрос со своими комментариями (***)
(может быть, кто-нибудь что-то полезное скажет)

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

Sub PriceOstatok()
'
' Макрос1 Макрос
' Макрос записан 15.10.2009 (Главный)
'

'*** Создаем новый лист "Price"

   Dim wsNewSheet As Worksheet
       Set wsNewSheet = ActiveWorkbook.Worksheets.Add
       With wsNewSheet
           .Name = "Price"
       End With

'*** Пишем заголовки столбцам на новом листе

   Range("A1:A1").Select
   ActiveCell.FormulaR1C1 = "№ п/п"
   With Selection
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
       .WrapText = True
       .Orientation = 0
       .AddIndent = False
       .IndentLevel = 0
       .ShrinkToFit = False
       .ReadingOrder = xlContext
       .MergeCells = False
   End With
   Columns("A:A").ColumnWidth = 4.3
   Rows("1:1").RowHeight = 40.5
   
   Range("B1:B1").Select
   ActiveCell.FormulaR1C1 = "Код ГБ"
   With Selection
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
       .WrapText = True
       .Orientation = 0
       .AddIndent = False
       .IndentLevel = 0
       .ShrinkToFit = False
       .ReadingOrder = xlContext
       .MergeCells = False
   End With
   Columns("B:B").ColumnWidth = 10
   
   Range("C1:C1").Select
   ActiveCell.FormulaR1C1 = "Код 1C"
   With Selection
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
       .WrapText = True
       .Orientation = 0
       .AddIndent = False
       .IndentLevel = 0
       .ShrinkToFit = False
       .ReadingOrder = xlContext
       .MergeCells = False
   End With
   Columns("C:C").ColumnWidth = 10
   
   Range("C1:C1").Select
   ActiveCell.FormulaR1C1 = "Код 1C"
   With Selection
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
       .WrapText = True
       .Orientation = 0
       .AddIndent = False
       .IndentLevel = 0
       .ShrinkToFit = False
       .ReadingOrder = xlContext
       .MergeCells = False
   End With
   Columns("C:C").ColumnWidth = 10
   
   Range("D1:D1").Select
   ActiveCell.FormulaR1C1 = "Группа"
   With Selection
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
       .WrapText = True
       .Orientation = 0
       .AddIndent = False
       .IndentLevel = 0
       .ShrinkToFit = False
       .ReadingOrder = xlContext
       .MergeCells = False
   End With
   Columns("D:D").ColumnWidth = 33.14

   Range("E1:E1").Select
   ActiveCell.FormulaR1C1 = "Подгруппа"
   With Selection
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
       .WrapText = True
       .Orientation = 0
       .AddIndent = False
       .IndentLevel = 0
       .ShrinkToFit = False
       .ReadingOrder = xlContext
       .MergeCells = False
   End With
   Columns("E:E").ColumnWidth = 36#

   Range("F1:F1").Select
   ActiveCell.FormulaR1C1 = "Фото товара"
   With Selection
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
       .WrapText = True
       .Orientation = 0
       .AddIndent = False
       .IndentLevel = 0
       .ShrinkToFit = False
       .ReadingOrder = xlContext
       .MergeCells = False
   End With
   Columns("F:F").ColumnWidth = 18#

   Range("G1:G1").Select
   ActiveCell.FormulaR1C1 = "Наименование товара"
   With Selection
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
       .WrapText = True
       .Orientation = 0
       .AddIndent = False
       .IndentLevel = 0
       .ShrinkToFit = False
       .ReadingOrder = xlContext
       .MergeCells = False
   End With
   Columns("G:G").ColumnWidth = 41.43
   
   Range("H1:H1").Select
   ActiveCell.FormulaR1C1 = "Шт в блоке"
   With Selection
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
       .WrapText = True
       .Orientation = 0
       .AddIndent = False
       .IndentLevel = 0
       .ShrinkToFit = False
       .ReadingOrder = xlContext
       .MergeCells = False
   End With
   Columns("H:H").ColumnWidth = 6.52
   
   Range("I1:I1").Select
   ActiveCell.FormulaR1C1 = "Шт в коробке"
   With Selection
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
       .WrapText = True
       .Orientation = 0
       .AddIndent = False
       .IndentLevel = 0
       .ShrinkToFit = False
       .ReadingOrder = xlContext
       .MergeCells = False
   End With
   Columns("I:I").ColumnWidth = 7
 
'*** Продолжаем писать заголовки столбцов от J до K, но в зависимости от значения в столбце J на "Лист1" - ??? не понял!

   Sheets("Лист1").Select
   PriceIsx = Range("J2").Value
   If PriceIsx = "400000009" Then
   
   Sheets("Price").Select
   Range("J1:J1").Select
   ActiveCell.FormulaR1C1 = "Цена РОЗНИЦА, руб."
   With Selection
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
       .WrapText = True
       .Orientation = 0
       .AddIndent = False
       .IndentLevel = 0
       .ShrinkToFit = False
       .ReadingOrder = xlContext
       .MergeCells = False
   End With
   Columns("J:J").ColumnWidth = 12.01
   Else
   If PriceIsx = "400000008" Then
   
   Sheets("Price").Select
   Range("J1:J1").Select
   ActiveCell.FormulaR1C1 = "Цена ОПТ, руб."
   With Selection
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
       .WrapText = True
       .Orientation = 0
       .AddIndent = False
       .IndentLevel = 0
       .ShrinkToFit = False
       .ReadingOrder = xlContext
       .MergeCells = False
   End With
   Columns("J:J").ColumnWidth = 12.01
   Else
   sName = InputBox("Выбранный Прайс-лист не является оптовым базовым или розничным базовым! Введите наименование Прайс-листа", "Name", "")
   
   Sheets("Price").Select
   Range("J1:J1").Select
   ActiveCell.FormulaR1C1 = "Цена " & sName & ", руб."
   With Selection
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
       .WrapText = True
       .Orientation = 0
       .AddIndent = False
       .IndentLevel = 0
       .ShrinkToFit = False
       .ReadingOrder = xlContext
       .MergeCells = False
   End With
   Columns("J:J").ColumnWidth = 12.01
   End If
   End If
       
   Sheets("Price").Select
   Range("K1:K1").Select
   ActiveCell.FormulaR1C1 = "Остаток общий резерв"
   With Selection
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
       .WrapText = True
       .Orientation = 0
       .AddIndent = False
       .IndentLevel = 0
       .ShrinkToFit = False
       .ReadingOrder = xlContext
       .MergeCells = False
   End With
   Columns("K:K").ColumnWidth = 12.57

'*** Кончили писать заголовки, уф!
'***ВСТАВЛЯЕМ ДАННЫЕ из "Лист1" в "Price"

'Определяем количество заполненных строк на Лист1
   Sheets("Лист1").Select
   
   Columns("A:A").Select
   Selection.NumberFormat = "0"
   
   SheetRows = ActiveWorkbook.ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
   ColRows = Application.WorksheetFunction.CountA(Range(Cells(1, 3), Cells(SheetRows, 3)))
   Application.ScreenUpdating = False
'определения номера последнего столбца в текущей строке
   Range("A1:A1").Select
   iLastCol = ActiveSheet.Cells(Selection.Row, 255).End(xlToLeft).Column
   iNum = 11
'Заносим наименование бегемотов
   For i = 12 To iLastCol
   Sheets("Лист1").Select
   j = i - 11
   Range("K1:K1").Activate
   ActiveCell.Offset(rowOffset:=0, columnOffset:=j).Activate
   sCMP = ActiveCell.Value
   iCMP = Replace(sCMP, "Склады ЦМП (кол-во)/", "")
   Sheets("Price").Select
   iNum = iNum + 1
   jx = iNum - 11
   Range("K1:K1").Activate
   ActiveCell.Offset(rowOffset:=0, columnOffset:=jx).Activate
   
        ActiveCell.FormulaR1C1 = "Остаток " & iCMP
   With Selection
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
       .WrapText = True
       .Orientation = 0
       .AddIndent = False
       .IndentLevel = 0
       .ShrinkToFit = False
       .ReadingOrder = xlContext
       .MergeCells = False
   End With
   sAdress = ActiveCell.Address
   nAdress = Replace(sAdress, "$", "")
   nnAdress = Replace(nAdress, "1", "")
   fAdress = nnAdress & ":" & nnAdress
   Range("A2:A2").Value = fAdress
   Columns(fAdress).ColumnWidth = 17.57
   Next i
   
   ItRows = 1
   NumSt = 0

'***Вставляем данные из Лист1 в Price (построчно считывая значения в столбцах)
   
   For i = 2 To ColRows
   'анализ данных
       Strok = ItRows + 1
       ItRows = Strok
       NumSt = NumSt + 1
       
       Sheets("Лист1").Select
       KodGB = Range("A" & i).Value
       Kod1C = Range("B" & i).Value
       Group = Range("C" & i).Value
       PodGroup = Range("D" & i).Value
       'Foto = Range("E" & i).Value
       NameTov = Range("F" & i).Value
       VBlock = Range("G" & i).Value
       VKor = Range("H" & i).Value
       PriceS = Range("I" & i).Value
       Rezerv = Range("K" & i).Value
       
           If Len(Range("E" & i).Value) <> 0 Then
           FotoTov = "\\x1\GB\Картинки\" & Range("E" & i).Value
           Else
           FotoTov = "0"
           End If
       'Заносим прайс-лист итоговый
       Dim Ostatok(100) As String
       For k = 12 To iLastCol
       Sheets("Лист1").Select
       st = k - 11
       Range("K" & i).Activate
       ActiveCell.Offset(rowOffset:=0, columnOffset:=st).Activate
       Ostatok(st) = ActiveCell.Value
       Next k


       Sheets("Price").Select
       Rows(Strok).RowHeight = 71.25
       Range("A" & Strok).Select
       ActiveCell.FormulaR1C1 = NumSt
   With Selection
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
       .WrapText = True
       .Orientation = 0
       .AddIndent = False
       .IndentLevel = 0
       .ShrinkToFit = False
       .ReadingOrder = xlContext
       .MergeCells = False
   End With
   
       Range("B" & Strok).Select
       ActiveCell.FormulaR1C1 = KodGB
   With Selection
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
       .WrapText = True
       .Orientation = 0
       .AddIndent = False
       .IndentLevel = 0
       .ShrinkToFit = False
       .ReadingOrder = xlContext
       .MergeCells = False
   End With
   
       Range("C" & Strok).Select
       ActiveCell.FormulaR1C1 = Kod1C
   With Selection
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
       .WrapText = True
       .Orientation = 0
       .AddIndent = False
       .IndentLevel = 0
       .ShrinkToFit = False
       .ReadingOrder = xlContext
       .MergeCells = False
   End With
   
       Range("D" & Strok).Select
       ActiveCell.FormulaR1C1 = Group
   With Selection
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
       .WrapText = True
       .Orientation = 0
       .AddIndent = False
       .IndentLevel = 0
       .ShrinkToFit = False
       .ReadingOrder = xlContext
       .MergeCells = False
   End With
   
       Range("E" & Strok).Select
       ActiveCell.FormulaR1C1 = PodGroup
   With Selection
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
       .WrapText = True
       .Orientation = 0
       .AddIndent = False
       .IndentLevel = 0
       .ShrinkToFit = False
       .ReadingOrder = xlContext
       .MergeCells = False
   End With
 
 
'''''''''''''''''''''''''''''''''''''''''
GoTo Z1
'***Пропустим пока эту операцию - Вставка фотографий (картинок) с сервера в столбец J
   
           If FotoTov <> "0" Then
           If Len(Dir(FotoTov)) <> 0 Then
           Range("F" & Strok).Select
           ActiveSheet.Pictures.Insert(FotoTov).Select
           With Selection
               .ShapeRange.LockAspectRatio = msoTrue
               .ShapeRange.Height = 65.25
               .ShapeRange.IncrementLeft 2.25
               .ShapeRange.IncrementTop 3#
               .ShapeRange.Rotation = 0#
               .Placement = xlMove
               .PrintObject = True
           End With
           If Selection.ShapeRange.Width > 115 Then
           Selection.ShapeRange.Width = 115
           End If
           End If
           End If
       
Z1:
'''''''''''''''''''''''''''''''''''''''''

       Range("G" & Strok).Select
       ActiveCell.FormulaR1C1 = NameTov
   With Selection
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
       .WrapText = True
       .Orientation = 0
       .AddIndent = False
       .IndentLevel = 0
       .ShrinkToFit = False
       .ReadingOrder = xlContext
       .MergeCells = False
   End With
   
       Range("H" & Strok).Select
       ActiveCell.FormulaR1C1 = VBlock
   With Selection
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
       .WrapText = True
       .Orientation = 0
       .AddIndent = False
       .IndentLevel = 0
       .ShrinkToFit = False
       .ReadingOrder = xlContext
       .MergeCells = False
   End With
   
       Range("I" & Strok).Select
       ActiveCell.FormulaR1C1 = VKor
   With Selection
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
       .WrapText = True
       .Orientation = 0
       .AddIndent = False
       .IndentLevel = 0
       .ShrinkToFit = False
       .ReadingOrder = xlContext
       .MergeCells = False
   End With
   
       Range("J" & Strok).Select
       ActiveCell.FormulaR1C1 = PriceS
   With Selection
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
       .WrapText = True
       .Orientation = 0
       .AddIndent = False
       .IndentLevel = 0
       .ShrinkToFit = False
       .ReadingOrder = xlContext
       .MergeCells = False
   End With
   
       Range("K" & Strok).Select
       ActiveCell.FormulaR1C1 = Rezerv
   With Selection
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
       .WrapText = True
       .Orientation = 0
       .AddIndent = False
       .IndentLevel = 0
       .ShrinkToFit = False
       .ReadingOrder = xlContext
       .MergeCells = False
   End With
   
       sNum = 0
       For s = 12 To iLastCol
       sNum = s
       jx = sNum - 11
       Sheets("Price").Select
       Range("K" & Strok).Activate
       ActiveCell.Offset(rowOffset:=0, columnOffset:=jx).Activate
       ActiveCell.Value = CStr(Ostatok(jx))
  With Selection
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
       .WrapText = True
       .Orientation = 0
       .AddIndent = False
       .IndentLevel = 0
       .ShrinkToFit = False
       .ReadingOrder = xlContext
       .MergeCells = False
   End With
       Next s
      Next i
     
     
'*** Рисуем границы у полученной таблицы

     Sheets("Price").Select
     'Определяем заполненную область
       ActiveSheet.Cells(1).SpecialCells(xlLastCell).Select
       iLastCellAdr$ = ActiveSheet.Cells(1).SpecialCells(xlLastCell).Address
       rLastCellAdr$ = Replace(iLastCellAdr$, "$", "")
           Range("A1:" & rLastCellAdr$).Select
   Selection.Borders(xlDiagonalDown).LineStyle = xlNone
   Selection.Borders(xlDiagonalUp).LineStyle = xlNone
   With Selection.Borders(xlEdgeLeft)
       .LineStyle = xlContinuous
       .Weight = xlThin
       .ColorIndex = xlAutomatic
   End With
   With Selection.Borders(xlEdgeTop)
       .LineStyle = xlContinuous
       .Weight = xlThin
       .ColorIndex = xlAutomatic
   End With
   With Selection.Borders(xlEdgeBottom)
       .LineStyle = xlContinuous
       .Weight = xlThin
       .ColorIndex = xlAutomatic
   End With
   With Selection.Borders(xlEdgeRight)
       .LineStyle = xlContinuous
       .Weight = xlThin
       .ColorIndex = xlAutomatic
   End With
   With Selection.Borders(xlInsideVertical)
       .LineStyle = xlContinuous
       .Weight = xlThin
       .ColorIndex = xlAutomatic
   End With
   With Selection.Borders(xlInsideHorizontal)
       .LineStyle = xlContinuous
       .Weight = xlThin
       .ColorIndex = xlAutomatic
   End With
End Sub


Тут, вроде бы, всё стандартно (копирование значений с одного листа на другой, вновь созданный, в ячейки по другим адресам), за исключением вставки фотографий с сервера - эта задача на этом форуме уже решалась, но для ODS.
Как будет в XLS - не знаю.

[Ninel]

вот с чем я разобралась:
создать новый лист
занести наименования столбцов

если в xls никак, то я смогу начальству это объяснить. (надеюсь на это)

пример со вставкой картинок я разбирала два дня. Это я оставлю напоследок.

"Продолжаем писать заголовки столбцов от J до K, но в зависимости от значения в столбце J на "Лист1" - ??? не понял!"
честно говоря тоже не понимаю зачем нужно это условие, т.к. меняется только заголовок столбца. Это можно опустить, я думаю.

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

[neft]

Тут я приводил макрос, который считывает ячейки с одного листа и записывает в другой:
http://forumooo.ru/index.php/topic,2367.msg14490.html#msg14490

Там, правда, бралась всего одна строка (зато на другом листе писалось в разные строки), но можно найти стандартный макрос, находящий номер последней заполненной строки на листе, и затем перебрать все строки по номерам.

[neft]

Функция для определения последней строки с данными (начинается отсчет с 0) и макрос для проверки:

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

Sub Main
MsgBox getLastUsedRow("Лист1")
End Sub

Function getLastUsedRow(namesheet) as Integer
  Dim oSheet As Object
  Dim oCell As Object
  Dim oCursor As Object
  Dim aAddress As Variant
  oSheet = ThisComponent.Sheets.getByName(namesheet)
  oCell = oSheet.GetCellbyPosition(0,0)
  oCursor = oSheet.createCursorByRange(oCell)
  oCursor.GotoEndOfUsedArea(True)
  aAddress = oCursor.RangeAddress
  GetLastUsedRow = aAddress.EndRow
End Function

[JohnSUN]

Желательно в xls

Это проблема!

Да нет, не такая уж и проблема, поскольку макрос можно записать не только в документ, но и "мимо документа", в библиотеку макросов.
То есть данные все-таки берутся и пишутся в xls, а макрос запускается из хранилища офиса.

Скажите, Ninel, а какая окончательная задача? Получить один из двух (или нескольких?) вариантов прайс-листа по таблице с исходными данными? А что потом? Выгрузить в PDF для отправки по почте? Разместить на сайте? Раздать менеджерам в виде книг xls?

[Ninel]

JohnSUN, прайс распространяется среди менеджеров и покупателей (оптовых), некоторые его распечатывают. Данные, которые лежат в Лист1, вставляются из программы ГБ (видимо, аналог 1С) в том виде, который вы видите. Формат .xls предпочтительнее только для удобства пользователей. Т.к. компания только начинает переходить на ООо и этот процесс затянется судя по всему. Т.е. девушка может попытаться открыть файл .ods в MS Office 2003, а потом техподдержку завалят такими заявками: "А у меня не открывается!".

[JohnSUN]

Под "ГБ" Вы имеете в виду "Главбух"?
Есть пара соображений:
1. Нацелиться сразу на вывод прайса в PDF-формате - раз уж его будут только печатать.
2. Если есть доступ к исходным данным, к самой программе, то попробовать исключить большую часть промежуточных преобразований в Calc - вроде бы к Главбуху идут какие-то утилиты для создания разных выходных форм.

PS. Хотя, вряд ли Главбух... Скорее "Гроссбух".

[Ninel]

Будете смеяться, но ГБ - это Граф Бестужев http://www.gbsoft.ru/projects/gb
Из этой программы данные для прайса (которые записаны в Лист1) получают таким путем:
из ГБ формируется отчет по нужным товарам, нажимается кнопочка "Для прайса", а затем обычной вставкой на Лист1. Вот собственно и все.

Вот, что получилось у меня (дорабатываю потихоньку): часть прайса на формулах, вставка картинки через макрос.

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

[JohnSUN]

Смеюсь. 
"...в 1728 году он был арестован и под стражею препровождён в Санкт-Петербург. Тогда обнаружилось его корыстолюбие, подтверждавшееся письмом самой Анны Ивановны к Петру II, что «Бестужев-Рюмин расхитил управляемое им имение и ввел её в долги неуплатные»." И вдруг: "Граф Бестужев" - система управления предприятием. 

Друг мой, Вы не могли бы слегка притормозить с реализацией проекта на макросах? Я тут рассматриваю другой вариант...

1. Создал новую базу данных в Base:
а) На первом шаге сказал Мастеру, что хочу подключиться к существующей базе данных - Эл.таблица.
б) На втором шаге ткнул офис носом в файл "мой прайс.xls"
в) На последнем шаге сказал, что базу нужно зарегистрировать и открыть.
г) Сохранил получившуюся заготовку как Создать прайс.odb
2. Создал запрос на основании данных из "мой прайс.xls":

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

SELECT "Код ГБ", "Код 1С", "Категория" AS "Группа", "Под категория" AS "Подгруппа",
CONCAT( '\\x1\GB\Картинки\', "картинка" ) AS "Фото товара",
"Товар.Название" AS "Наименование товара",
"В Бл." AS "Шт в блоке",
"В Кор" AS "Шт в коробке",
"Цена" AS "Цена ОПТ, руб.",
"Общий резерв" AS "Остаток общий резерв"
FROM "Лист1"
WHERE "ServerParams.IPriceLists" = 400000008
(на самом деле создавал в режиме дизайна, просто тыкал мышкой в разные клеточки и совсем чуть-чуть написал с клавиатуры. А текст запроса получился именно таким)
Сохранил этот запрос под именем ЗапросОпт. Скопировал его и опять вставил с именем ЗапросРозница. Вошел в редактирование этого нового запроса, изменил одну цифру (последнюю, 8 на 9) и слова "Цена ОПТ" сменил на "Цена РОЗНИЦА".
Сохранил всё что получилось.
3. Создал новую книгу Calc из двух листов - ОПТ и РОЗНИЦА. Это будет шаблон для создания готовых прайсов.

Что собираюсь сделать дальше: отформатировать заголовки, добавить макрос преобразования адресов картинок в сами картинки и выгрузки готовых прайсов в PDF-формат...

Если бы Вы еще и картинки этих трех пупсов дали - вообще красота была бы! Во-первых, можно было бы отлаживать макрос на реальных данных. Во-вторых, интересно было бы взглянуть на артикул 400105450 - я сам когда-то наплакался с аксесс 

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

[Ninel]

JohnSUN, вы меня покорили!!!

Приторможу, но поковыряюсь для общего развития не повредит.

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

[JohnSUN]

Хороши малыши!  

Я забыл рассказать про самую-самую классную фишку!
В этой книге шаблонов я нажал F4 (меню Вид-Источники данных). В открывшемся дереве выбрал запрос и просто ПЕРЕТАЩИЛ его в нужное место листа.
Осталось указать параметры этого диапазона данных (меню Данные-Определить диапазон) и отформатировать заголовки.
Получается, что все заголовки уже есть в запросе, всё форматирование уже находится в шаблоне. А значит отпадает необходимость во всех этих бесконечных

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

   Range("B1:B1").Select
   ActiveCell.FormulaR1C1 = "Код ГБ"
   With Selection
       .HorizontalAlignment = xlCenter
       .VerticalAlignment = xlCenter
       .WrapText = True
       .Orientation = 0
       .AddIndent = False
       .IndentLevel = 0
       .ShrinkToFit = False
       .ReadingOrder = xlContext
       .MergeCells = False
   End With
   Columns("B:B").ColumnWidth = 10
и итоговый макрос становится на треть короче.

Порядок работы с итоговым шаблоном должен получиться очень простым: данные из ГБ всегда сохраняем в одну и ту же книгу с одним и тем же именем в одном и том же месте. База всегда знает где искать исходные данные. Открываем файл шаблонов. Срабатывает макрос, который можно "подвесить" на событие "Открытие документа". Этот макрос обновляет данные на листах, вставляет картинки вместо их адресов, экспортирует в PDF и закрывает шаблон без сохранения. То есть, получается, что шаблончик всегда будет маленький, без данных и без картинок. А прайсы будут формироваться при каждом его открытии. Ну, как-то так, в общем...

PS. Забыл сказать! Действительно, в текстах запросов желательно писать file://X1/GB... Это я погорячился.
И вопрос об xls автоматически отпадает - только исходные данные в нем, а рассылать можно и в PDF

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

[Ninel]

JohnSUN, спасибо.
Базу создала, шаблон тоже. Макросом буду заниматься завтра.