ReSQL.ru
     
powered by simpleCommunicator - 2.0.38     © 2025 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Метод Pastespecial из класса Range падает с ошибкой Run-time error 91
10 сообщений из 10, страница 1 из 1
Метод Pastespecial из класса Range падает с ошибкой Run-time error 91
    #39672810
zorlo
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
zorlo
Гость
Добрый день!
Совсем новичок в 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, 01:23
| Ответить | Цитировать | Написать  
Метод Pastespecial из класса Range падает с ошибкой Run-time error 91
    #39672883
Фотография The_Prist
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
The_Prist
Участник
zorlo,

.header.group - что это должно означать по-вашему? А .header.format?
Я к чему - метод Group относится к сводной таблице, а что такое header объект Range вообще не знает.
Отсюда вопрос: что за тип у объекта ranges, к свойствам и методам которого Вы там обращаетесь?
...
Рейтинг: 0 / 0
12.07.2018, 09:19
| Ответить | Цитировать | Написать  
Метод Pastespecial из класса Range падает с ошибкой Run-time error 91
    #39673055
zorlo
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
zorlo
Гость
Код: 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:38
| Ответить | Цитировать | Написать  
Метод Pastespecial из класса Range падает с ошибкой Run-time error 91
    #39673076
Фотография The_Prist
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
The_Prist
Участник
zorlo,

ну и как после этого что-то подсказать? Без модуля clsRanges нечего сказать, т.к. окончательное формирование объекта происходит именно там.
...
Рейтинг: 0 / 0
12.07.2018, 12:52
| Ответить | Цитировать | Написать  
Метод Pastespecial из класса Range падает с ошибкой Run-time error 91
    #39673085
zorlo
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
zorlo
Гость
Объекты 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:01
| Ответить | Цитировать | Написать  
Метод Pastespecial из класса Range падает с ошибкой Run-time error 91
    #39673094
zorlo
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
zorlo
Гость
Можно по почте вам прислать класс? Он не маленький
...
Рейтинг: 0 / 0
12.07.2018, 13:05
| Ответить | Цитировать | Написать  
Метод Pastespecial из класса Range падает с ошибкой Run-time error 91
    #39673104
Фотография Shocker.Pro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Shocker.Pro
Участник
zorloОн не маленький публикуйте в спойлере
...
Рейтинг: 0 / 0
12.07.2018, 13:20
| Ответить | Цитировать | Написать  
Метод Pastespecial из класса Range падает с ошибкой Run-time error 91
    #39673122
zorlo
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
zorlo
Гость
Сам класс

 
Код: 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, 13:34
| Ответить | Цитировать | Написать  
Метод Pastespecial из класса Range падает с ошибкой Run-time error 91
    #39673226
zorlo
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
zorlo
Гость
Если есть какие-то мысли, прошу, пожалуйста, подскажите, в каком направлении дальше двигаться?
Заранее огромное спасибо!!!
...
Рейтинг: 0 / 0
12.07.2018, 16:10
| Ответить | Цитировать | Написать  
Метод Pastespecial из класса Range падает с ошибкой Run-time error 91
    #39673268
Фотография The_Prist
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
The_Prist
Участник
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
12.07.2018, 17:15
| Ответить | Цитировать | Написать  
10 сообщений из 10, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Метод Pastespecial из класса Range падает с ошибкой Run-time error 91
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение
NoSQL.ru             Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=61&msg=39673122&tid=2172290]:
 0ms
get settings:
 8ms
get forum list:
 14ms
check forum access:
 4ms
check topic access:
 4ms
track hit:
 55ms
get topic data:
 11ms
get forum data:
 3ms
get page messages:
 48ms
get tp. blocked users:
 2ms
others: 281ms
total:  430ms
созд. / загр.: 430ms
x
x
Закрыть


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