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

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

27 Февраль 2021, 22:15 *
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
Вам не пришло письмо с кодом активации?

Войти
Новости: Часто задаваемые вопросы по LibreOffice и Apache OpenOffice.org
 
   Начало   Помощь Поиск Войти Регистрация    задать вопрос  
Страниц: 1 2 »   Вниз
  Печать  
Автор Тема: Переделать макрос для Excel под OOo  (Прочитано 14254 раз)
0 Пользователей и 1 Гость смотрят эту тему.
Ninel
Участник
**
Offline Offline

Сообщений: 8


« Стартовое сообщение: 16 Январь 2012, 11:18 »

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

[вложение удалено Администратором]
Записан
neft
Форумчанин
***
Offline Offline

Сообщений: 189


« Ответ #1: 16 Январь 2012, 13:36 »

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


Отвечать обязательно!
Записан
Ninel
Участник
**
Offline Offline

Сообщений: 8


« Ответ #2: 16 Январь 2012, 13:44 »

Желательно в xls
Записан
neft
Форумчанин
***
Offline Offline

Сообщений: 189


« Ответ #3: 16 Январь 2012, 13:56 »

Цитата:
Желательно в 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 - не знаю.
« Последнее редактирование: 16 Январь 2012, 13:58 от neft » Записан
Ninel
Участник
**
Offline Offline

Сообщений: 8


« Ответ #4: 16 Январь 2012, 14:24 »

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

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

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

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

[вложение удалено Администратором]
Записан
neft
Форумчанин
***
Offline Offline

Сообщений: 189


« Ответ #5: 16 Январь 2012, 14:46 »

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

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

Сообщений: 189


« Ответ #6: 16 Январь 2012, 15:04 »

Функция для определения последней строки с данными (начинается отсчет с 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
Капитана в тот день называли на "ты"
Гуру
*******
Offline Offline

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


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


WWW
« Ответ #7: 17 Январь 2012, 10:22 »

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

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

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

Сообщений: 8


« Ответ #8: 17 Январь 2012, 10:59 »

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

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


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


WWW
« Ответ #9: 17 Январь 2012, 11:15 »

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

PS. Хотя, вряд ли Главбух... Скорее "Гроссбух".
« Последнее редактирование: 17 Январь 2012, 11:53 от JohnSUN » Записан

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

Сообщений: 8


« Ответ #10: 17 Январь 2012, 12:29 »

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

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

[вложение удалено Администратором]
Записан
JohnSUN
Капитана в тот день называли на "ты"
Гуру
*******
Offline Offline

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


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


WWW
« Ответ #11: 17 Январь 2012, 13:07 »

Смеюсь.  Смеющийся
"...в 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 - я сам когда-то наплакался с аксесс  Смеющийся

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

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

Сообщений: 8


« Ответ #12: 17 Январь 2012, 13:18 »

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

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

[вложение удалено Администратором]
Записан
JohnSUN
Капитана в тот день называли на "ты"
Гуру
*******
Offline Offline

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


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


WWW
« Ответ #13: 17 Январь 2012, 13:53 »

Хороши малыши!  Смеющийся

Я забыл рассказать про самую-самую классную фишку!
В этой книге шаблонов я нажал 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

[вложение удалено Администратором]
« Последнее редактирование: 17 Январь 2012, 13:58 от JohnSUN » Записан

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

Сообщений: 8


« Ответ #14: 17 Январь 2012, 15:13 »

JohnSUN, спасибо.
Базу создала, шаблон тоже. Макросом буду заниматься завтра.
Записан
Страниц: 1 2 »   Вверх
  Печать  
 
Перейти в:  

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