Гость
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Метод Pastespecial из класса Range падает с ошибкой Run-time error 91 / 10 сообщений из 10, страница 1 из 1
12.07.2018, 01:23
    #39672810
zorlo
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Метод Pastespecial из класса Range падает с ошибкой Run-time error 91
Добрый день!
Совсем новичок в vba-программировании и в макросах excel.
Опишу проблему:

Есть отчёт в oracle bi analytics. Помимо отображения в bi есть возможность сформировать .xltx-шаблон на основе отображаемых данных в bi. Как это должно работать:

1) При нажатии кнопки "Сформировать отчёт" запускается скрипт vba.
2) Скрипт vba передаёт данные xls, где описан макрос, который заполняет шаблон xltx на основе переданных данных.

На этапе попытки заполнить xltx файл выпадает ошибка "Run-time error 91 Object variable or With block variable not set" и указывает на текущий кусок кода: .header.format(rangeData).Copy: .header.group(rangeData).PasteSpecial xlPasteFormats: .header.group(rangeData).PasteSpecial xlPasteColumnWidths


Подскажите, что может быть не так? На всякий случай привожу нужные куски кода:


Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
Public Sub Report_Passive(Report_Param As String)
    Call Create_Report(Report_Path, Report_Param, _
        "Наименование.xltx")
    
    ranges.total.group(rangeDescription).Value = "Общий объем" & Chr(10) & "   в том числе:"
    Dim c As Long, col As Range
    For Each col In ranges.header.group(rangeData).Columns
        If col.Rows(1).Value <> "" Then
            col.Rows(1).Value = format(col.Rows(1).Value, "dd.mm.yyyy") & " г."
            col.Rows(2).Value = "Всего"
            col.Rows(2).Offset(, 1).Value = "Участие": col.Rows(2).Offset(, 2).Value = "Долговые"
        End If
    Next
End Sub




Private Sub Create_Report(Path As String, Report_Param As String, Template_Name As String)
    'Определение форматов
    Set wsFormats = Application.ThisWorkbook.ActiveSheet
    With ranges
        Set .header = New clsRanges: .header.SetFormats wsFormats.Range("B4:B5"), wsFormats.Range("D4:F5")
        Set .total = New clsRanges:  .total.SetFormats wsFormats.Range("B7"), wsFormats.Range("D7:F7")
        Set .detail = New clsRanges: .detail.SetFormats wsFormats.Range("B11"), wsFormats.Range("D11:F11")
    End With
    
    Set ws = Application.Workbooks.Add(TemplateFolder & Template_Name).ActiveSheet
    ws.Activate
    Application.ScreenUpdating = False
    'Application.Calculation = xlCalculationManual
    
    'Загрузка данных
    Call GetData(Path, Report_Param, ws.Range("A7"))
    'Форматирование отчета
    Call ParseData
    Call FormatHeaders
    Call FormatData
    Call AdvanceConfidentiality
    
    ws.Range("A2").Value = ws.Range("A2").Value & minYear & "-" & maxYear & " гг. "
    ws.Range("A1").Select
    
    Application.Calculation = xlCalculationAutomatic
    Application.Calculate
    Application.ScreenUpdating = True
    Application.StatusBar = ""
End Sub



Private Sub FormatData()
    'Форматирование
    With ranges
        'Удаление лишних строк
        ws.Range("A7:A9").EntireRow.Delete
        'ws.Range(.detail.group(rangeDescription).Areas(.detail.group(rangeDescription).Areas.Count - 1), .detail.group(rangeDescription).Areas(.detail.group(rangeDescription).Areas.Count)).EntireRow.Delete
        'Заголовок
        ws.Range("A2").Resize(, ws.Range("A1").SpecialCells(xlCellTypeLastCell).Column).Merge
        ws.Range("A3").Resize(, ws.Range("A1").SpecialCells(xlCellTypeLastCell).Column).Merge
        ws.Range("A4").Resize(, ws.Range("A1").SpecialCells(xlCellTypeLastCell).Column).Merge
        .header.group(rangeDescription).ColumnWidth = .header.format(rangeDescription).ColumnWidth
        .header.format(rangeData).Copy: .header.group(rangeData).PasteSpecial xlPasteFormats: .header.group(rangeData).PasteSpecial xlPasteColumnWidths
        'Данные
        .detail.ApplyFormatsToGroup rangeDescription ': .detail.ApplyFormatsToGroup rangeData
        .detail.format(rangeData).Copy: .detail.group(rangeData).PasteSpecial xlPasteFormats
        .detail.group(rangeDescription).Borders(xlEdgeBottom).Weight = xlMedium: .detail.group(rangeData).Borders(xlEdgeBottom).Weight = xlMedium
        .total.ApplyFormatsToGroup rangeDescription ': .total.ApplyFormatsToGroup rangeData
        .total.format(rangeData).Copy: .total.group(rangeData).PasteSpecial xlPasteFormats
        'Примечание
        ws.Shapes("Description").Top = ws.cells(.detail.group(rangeDescription).Areas(.detail.group(rangeDescription).Areas.Count).row + .detail.group(rangeDescription).Areas(.detail.group(rangeDescription).Areas.Count).Count + 2, 1).Top
        ws.cells(.detail.group(rangeDescription).cells(.detail.group(rangeDescription).Rows.Count).row + 1, 1).EntireRow.Delete
        'Дополнительно
        'With ws.Range("D3")
        '    .Copy ws.cells(.row, ranges.detail.group(rangeData).Areas(1).Columns.Count + 1)
        '    .Value = ""
        'End With
        ws.cells.Font.Name = "Times New Roman"
    End With
End Sub

Модератор: Учимся использовать тэги оформления кода - FAQ
...
Рейтинг: 0 / 0
12.07.2018, 09:19
    #39672883
The_Prist
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Метод Pastespecial из класса Range падает с ошибкой Run-time error 91
zorlo,

.header.group - что это должно означать по-вашему? А .header.format?
Я к чему - метод Group относится к сводной таблице, а что такое header объект Range вообще не знает.
Отсюда вопрос: что за тип у объекта ranges, к свойствам и методам которого Вы там обращаетесь?
...
Рейтинг: 0 / 0
12.07.2018, 12:38
    #39673055
zorlo
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Метод Pastespecial из класса Range падает с ошибкой Run-time error 91
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
Private Type udtRanges
    header As clsRanges
    total As clsRanges
    detail As clsRanges
End Type

Private ranges As udtRanges
...
Рейтинг: 0 / 0
12.07.2018, 12:52
    #39673076
The_Prist
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Метод Pastespecial из класса Range падает с ошибкой Run-time error 91
zorlo,

ну и как после этого что-то подсказать? Без модуля clsRanges нечего сказать, т.к. окончательное формирование объекта происходит именно там.
...
Рейтинг: 0 / 0
12.07.2018, 13:01
    #39673085
zorlo
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Метод Pastespecial из класса Range падает с ошибкой Run-time error 91
Объекты ranges и ws определяются в начале кода:

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
Private Type udtRanges
    header As clsRanges
    total As clsRanges
    detail As clsRanges
End Type

Private ranges As udtRanges, minYear As Integer, maxYear As Integer
Private ws As Worksheet, wsFormats As Worksheet





Это всё, что есть об этом объекте...
Есть ещё два куска кода, но не думаю, что они будут причастны:

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
Private Sub ParseData()
Dim r As Range, row As Integer, col As Integer, level As Integer
Dim col_step As Integer, tmpRanges As clsRanges
    col_step = ranges.header.format(rangeData).Columns.Count
    'Удаление лишних столбцов
    ws.Range("B1").EntireColumn.Delete xlShiftToLeft
    row = 9
    col = 3
    Do Until col >= ws.Range("A1").SpecialCells(xlCellTypeLastCell).Column
        'Удаление лишних ячеек
        ws.cells(row - 1, col).Delete xlShiftToLeft
        ws.cells(row, col).Delete xlShiftToLeft
        DoEvents
        col = col + 1
    Loop
    row = 10
    Do Until row > ws.Range("A1").SpecialCells(xlCellTypeLastCell).row
        'Удаление лишних ячеек
        If ws.cells(row, 1).Value = "в том числе" Then ws.cells(row, 1).EntireRow.Delete xlShiftUp
        col = 2
        Do Until col >= ws.Range("A1").SpecialCells(xlCellTypeLastCell).Column
            ws.cells(row, col).Delete xlShiftToLeft
            col = col + 1
        Loop
        DoEvents
        row = row + 1
    Loop
    ws.UsedRange.Select
    row = 10
    Do Until row > ws.Range("A1").SpecialCells(xlCellTypeLastCell).row
        'Обработка
        Set tmpRanges = Nothing
        Set r = ws.cells(row, 1)
        Select Case GetLevelName(r.Value)
            Case "Итог":                        level = 0: r.IndentLevel = level: Set tmpRanges = ranges.total
            Case "Детали":    r.IndentLevel = level + 1: Set tmpRanges = ranges.detail
        End Select
        If Not tmpRanges Is Nothing Then
            tmpRanges.AddRangeToGroup rangeDescription, r
            For col = 1 To ws.Range("A1").SpecialCells(xlCellTypeLastCell).Column - 1 Step col_step
                tmpRanges.AddRangeToGroup rangeData, r.Offset(, col).Resize(, col_step)
            Next
        End If
        Application.StatusBar = "Обработка: " & FormatPercent(row / ws.Range("A1").SpecialCells(xlCellTypeLastCell).row, 2)
        DoEvents
        row = row + 1
    Loop
End Sub






Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
Private Sub FormatHeaders()
Dim col As Integer, d As Date
Dim col_step As Integer
    col_step = ranges.header.format(rangeData).Columns.Count
    ranges.header.AddRangeToGroup rangeDescription, ws.Range("A5:A6")
    For col = 2 To ws.Range("A1").SpecialCells(xlCellTypeLastCell).Column Step col_step
        If ws.cells(8, col).Value Like "#### год # квартал*" Then
            d = DateSerial(Left(ws.cells(8, col).Value, 4), Mid(ws.cells(8, col).Value, 10, 1) * 3, 1)
            If d = #3/1/2015# Then d = DateAdd("m", -2, d) Else d = DateAdd("m", 1, d)
            ws.cells(5, col).Value = d
            'ws.cells(5, col).Value = format(d, "dd.mm.yyyy") & " г."
            'ws.cells(6, col).Value = "Всего": ws.cells(6, col + 1).Value = "Участие": ws.cells(6, col + 2).Value = "Долгов"
            ranges.header.AddRangeToGroup rangeData, ws.Range(ws.cells(5, col), ws.cells(6, col + 2))
            If minYear = 0 Then minYear = Year(d)
            If Year(d) > maxYear Then maxYear = Year(d)
        End If
    Next
End Sub
...
Рейтинг: 0 / 0
12.07.2018, 13:05
    #39673094
zorlo
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Метод Pastespecial из класса Range падает с ошибкой Run-time error 91
Можно по почте вам прислать класс? Он не маленький
...
Рейтинг: 0 / 0
12.07.2018, 13:20
    #39673104
Shocker.Pro
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Метод Pastespecial из класса Range падает с ошибкой Run-time error 91
zorloОн не маленький публикуйте в спойлере
...
Рейтинг: 0 / 0
12.07.2018, 13:34
    #39673122
zorlo
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Метод Pastespecial из класса Range падает с ошибкой Run-time error 91
Сам класс

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
Option Explicit

Public Enum enmType
    rangeDescription = 1
    rangeData = 2
End Enum

Private rangeGroupDescription As Range, rangeGroupData As Range
Private rangeFormatDescription As Range, rangeFormatData As Range

Public Property Get group(rangeType As enmType) As Range
    Select Case rangeType
        Case rangeDescription: Set group = rangeGroupDescription
        Case rangeData: Set group = rangeGroupData
    End Select
End Property
Public Property Set group(rangeType As enmType, ByRef r As Range)
    Select Case rangeType
        Case rangeDescription: Set rangeGroupDescription = r
        Case rangeData: Set rangeGroupData = r
    End Select
End Property

Public Property Get format(rangeType As enmType) As Range
    Select Case rangeType
        Case rangeDescription: Set format = rangeFormatDescription
        Case rangeData: Set format = rangeFormatData
    End Select
End Property
Public Property Set format(rangeType As enmType, ByRef r As Range)
    Select Case rangeType
        Case rangeDescription: Set rangeFormatDescription = r
        Case rangeData: Set rangeFormatData = r
    End Select
End Property

Public Sub AddRangeToGroup(rangeType As enmType, ByRef r As Range)
    Select Case rangeType
        Case rangeDescription
            If rangeGroupDescription Is Nothing Then Set rangeGroupDescription = r Else Set rangeGroupDescription = Union(rangeGroupDescription, r)
        Case rangeData
            If rangeGroupData Is Nothing Then Set rangeGroupData = r Else Set rangeGroupData = Union(rangeGroupData, r)
    End Select
End Sub

Public Sub SetFormats(ByRef rangeDescriptionFormats As Range, ByRef rangeDataFormats As Range)
    Set format(rangeDescription) = rangeDescriptionFormats
    Set format(rangeData) = rangeDataFormats
End Sub

Public Sub ApplyFormatsToGroup(rangeType As enmType)
    Select Case rangeType
        Case rangeDescription: Call ApplyFormat(rangeGroupDescription, rangeFormatDescription)
        Case rangeData: Call ApplyFormat(rangeGroupData, rangeFormatData)
    End Select
End Sub

Private Sub ApplyFormat(ByRef r As Range, ByRef rFormat As Range)
On Error Resume Next
    If Not r Is Nothing Then
        'rFormat.Copy: r.PasteSpecial xlPasteFormats, xlNone, False, False
        With rFormat
            Dim xlIndex As XlBordersIndex
            For xlIndex = xlEdgeLeft To xlInsideHorizontal
                With .Borders(xlIndex)
                    r.Borders(xlIndex).Color = .Color
                    r.Borders(xlIndex).ColorIndex = .ColorIndex
                    r.Borders(xlIndex).LineStyle = .LineStyle
                    r.Borders(xlIndex).TintAndShade = .TintAndShade
                    r.Borders(xlIndex).Weight = .Weight
                    If xlIndex = xlInsideHorizontal Then r.Borders(xlIndex).Weight = xlHairline Else r.Borders(xlIndex).Weight = .Weight
                End With
            Next
            With .Font
                r.Font.Background = .Background
                r.Font.Bold = .Bold
                r.Font.Color = .Color
                r.Font.ColorIndex = .ColorIndex
                r.Font.FontStyle = .FontStyle
                r.Font.Italic = .Italic
                r.Font.Name = .Name
                r.Font.Size = .Size
                r.Font.Strikethrough = .Strikethrough
                r.Font.Subscript = .Subscript
                r.Font.Superscript = .Superscript
                r.Font.ThemeColor = .ThemeColor
                r.Font.ThemeFont = .ThemeFont
                r.Font.TintAndShade = .TintAndShade
                r.Font.Underline = .Underline
                
            End With
            r.FormulaHidden = .FormulaHidden
            r.HorizontalAlignment = .HorizontalAlignment
            r.VerticalAlignment = .VerticalAlignment
            With .Interior
                r.Interior.Color = .Color
                r.Interior.ColorIndex = .ColorIndex
                r.Interior.Pattern = .Pattern
                r.Interior.PatternColor = .PatternColor
                r.Interior.PatternColorIndex = .PatternColorIndex
                r.Interior.PatternTintAndShade = .PatternTintAndShade
                r.Interior.ThemeColor = .ThemeColor
                r.Interior.TintAndShade = .TintAndShade
            End With
            r.MergeCells = .MergeCells
            r.NumberFormat = .NumberFormat
            r.NumberFormatLocal = .NumberFormatLocal
            r.Orientation = .Orientation
            r.ShrinkToFit = .ShrinkToFit
            r.VerticalAlignment = .VerticalAlignment
            r.WrapText = .WrapText
            r.FormatConditions.Delete
            Dim fc As FormatCondition, fc_r As FormatCondition
            For Each fc In .FormatConditions
                Set fc_r = r.FormatConditions.Add(fc.Type, fc.Operator, fc.Formula1, fc.Formula2)
                fc_r.NumberFormat = fc.NumberFormat
                fc_r.StopIfTrue = False
            Next
        End With
    End If
End Sub



Модератор: Публикация в спойлере не отменяет необходимость SRC. Поправил....
...
Рейтинг: 0 / 0
12.07.2018, 16:10
    #39673226
zorlo
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Метод Pastespecial из класса Range падает с ошибкой Run-time error 91
Если есть какие-то мысли, прошу, пожалуйста, подскажите, в каком направлении дальше двигаться?
Заранее огромное спасибо!!!
...
Рейтинг: 0 / 0
12.07.2018, 17:15
    #39673268
The_Prist
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Метод Pastespecial из класса Range падает с ошибкой Run-time error 91
zorloв каком направлении дальше двигаться?В этом: Отлов ошибок и отладка кода VBA
Потому что разбираться в километровых запутанных(непонятно для чего, кстати) кодах не такая уж быстрая задача.
Самое простое, что можно предположить по ошибке, это:
Вариант 1.
Код: plaintext
.header.group(rangeData)
возвращает Nothing. Такое может быть, когда этим самым rangeGroupe значение просто не назначалось. А вот почему - на этот вопрос только отладка на реальном файле может подсказать.
Вариант 2.
Код: plaintext
.header.group(rangeData)
содержит определение для несвязанных диапазонов. А специальная вставка не может быть выполнена в несвязанные диапазоны. Попробуйте записать так:
Код: vbnet
1.
.header.format(rangeData).Copy: .header.group(rangeData).Cells(1).PasteSpecial xlPasteFormats: .header.group(rangeData).Cells(1).PasteSpecial xlPasteColumnWidths


Если сработает - значит именно в этом и дело.
...
Рейтинг: 0 / 0
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Метод Pastespecial из класса Range падает с ошибкой Run-time error 91 / 10 сообщений из 10, страница 1 из 1
Целевая тема:
Создать новую тему:
Автор:
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]