1 Тема от Yury Vitovsky Отредактировано Yury Vitovsky (2016-05-27 10:18:16)

  • Yury Vitovsky
  • Yury Vitovsky
  • Member
  • Неактивен
  • Зарегистрирован: 2016-05-11
  • Сообщений: 163

Тема: MyMacro.xls - дополнительная обработка отчетов

Добрый день!
Вопрос-предложение. Есть в тиражной поставке Универсала (в папке EXE) такой файл - MyMacro.xls.
Он предназначен для хранения пользовательских макросов для пост-обработки ваших отчетов.
Т.е. в свойствах отчета вы можете определить имя макроса из этого файла, и он выполнится после загрузки отчета.
Как правило, это используют для их дополнительного форматирования.

Если Вы пользовались этой возможностью, писали подобные макросы, думаете, что они могут быть интересны вашим коллегам и готовы ими поделиться - пожалуйста, присылайте.
Мы включим их в тиражную поставку. Также будем добавлять макросы, известные нам.
Также интересуют ваши пожелания по теме.

С уважением,
Юрий Витовский
СофтПро

2 Ответ от Yury Vitovsky Отредактировано Yury Vitovsky (2017-04-05 15:10:25)

  • Yury Vitovsky
  • Yury Vitovsky
  • Member
  • Неактивен
  • Зарегистрирован: 2016-05-11
  • Сообщений: 163

Re: MyMacro.xls - дополнительная обработка отчетов

Если у вас есть отчет, расположенный на нескольких листах, а вы хотите его собрать на один, то может помочь этот макрос.
Добавьте его в MyMacro.xls и вызовите в свойствах отчета ("Дополнительный макрос")

Sub ManySheets2One()
Dim i, nSheetsCount, LastRowTarget, LastRowSource As Long
Dim wb As Workbook
Dim wsMain, ws As Worksheet
Dim oSrcRange, oTrgRange As Range

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set wb = ActiveWorkbook
    Set wsMain = wb.Sheets(1)
    
    nSheetsCount = ActiveWorkbook.Sheets.Count
    LastRowTarget = wsMain.Cells.SpecialCells(xlLastCell).Row - 1

    For i = 2 To nSheetsCount
        Set ws = ActiveWorkbook.Sheets(i)
        ws.Activate
        LastRowSource = ws.Cells.SpecialCells(xlLastCell).Row
        Set oSrcRange = ws.Range(Cells(2, 2), Cells(LastRowSource, 8))
        
        wsMain.Activate
        
        wsMain.Cells(LastRowTarget, 2).Activate
        Set oTrgRange = Selection        
        oSrcRange.Copy oTrgRange
        
        LastRowTarget = LastRowTarget + LastRowSource
        Do While IsEmpty(wsMain.Cells(LastRowTarget, 2))
            LastRowTarget = LastRowTarget - 1
        Loop
        LastRowTarget = LastRowTarget + 2
    Next i
    
    wsMain.Cells.EntireColumn.AutoFit
    
    For Each ws In wb.Sheets
        If ws.Name <> wsMain.Name Then
            ws.Activate
            ActiveWindow.SelectedSheets.Delete
        End If
        
    Next ws
    
    wsMain.Cells(2, 2).Activate
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub