Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Ошибка макроса - Method "Add" of object "ListObject" failed
 
#1
11.01.2021 15:18:48
Добрый день!

Записал макрос. На некоторых файлах все выполняется отлично а на некоторых выдает ошибку:
Цитата
Run-time error -2147417848 (80010108)
Method "Add" of object "ListObject" failed
Т.е. после запуска, просто зависает программ, нажимаешь закрыть, и Windows дает - перезапуск Excel ну  и после выводится ошибка VBA.

Подскажите пожалуйста кто с этим сталкивался, как можно исправить?
Код
Sub Макрос12()
' Макрос12 Макрос

    Sheets("Словарь").Select
   ' удаление строк
       Dim ra As Range, delra As Range
    Application.ScreenUpdating = False    ' отключаем обновление экрана
    ' ищем и удаляем строки, содержащие заданный текст
    ' (можно указать сколько угодно значений, и использовать подстановочные знаки)
    УдалятьСтрокиСТекстом = Array("на", "для", "идти", "если", "при", "это", "до", "о", "из", "надо", "за", "в", "с", "как", "какой", "к", "что", "по", "где")
    ' перебираем все строки в используемом диапазоне листа
    For Each ra In ActiveSheet.UsedRange.Rows
        ' перебираем все фразы в массиве
        For Each word In УдалятьСтрокиСТекстом
            ' если в очередной строке листа найден искомый текст
            If Not ra.Find(word, , xlValues, xlWhole) Is Nothing Then
                ' добавляем строку в диапазон для удаления
                If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
            End If
        Next word
    Next
 
    ' если подходящие строки найдены, то: (оставьте одну из 2 следующих строк)
    ' скрываем их If Not delra Is Nothing Then delra.EntireRow.Hidden = True    
    If Not delra Is Nothing Then delra.EntireRow.Delete    ' удаляем их
' удаление строк конец
' применение форматирование
    Columns("A:A").Select
    Selection.FormatConditions.AddColorScale ColorScaleType:=3
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _
        xlConditionValueLowestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
        .Color = 8109667
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _
        xlConditionValuePercentile
    Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50
    With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor
        .Color = 8711167
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _
        xlConditionValueHighestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor
        .Color = 7039480
        .TintAndShade = 0
    End With
    Columns("A:A").Select
    Selection.FormatConditions.AddDatabar
    Selection.FormatConditions(Selection.FormatConditions.Count).ShowValue = True
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1)
        .MinPoint.Modify newtype:=xlConditionValueAutomaticMin
        .MaxPoint.Modify newtype:=xlConditionValueAutomaticMax
    End With
    With Selection.FormatConditions(1).BarColor
        .Color = 15698432
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).BarFillType = xlDataBarFillSolid
    Selection.FormatConditions(1).Direction = xlContext
    Selection.FormatConditions(1).NegativeBarFormat.ColorType = xlDataBarColor
    Selection.FormatConditions(1).BarBorder.Type = xlDataBarBorderNone
    Selection.FormatConditions(1).AxisPosition = xlDataBarAxisAutomatic
    With Selection.FormatConditions(1).AxisColor
        .Color = 0
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).NegativeBarFormat.Color
        .Color = 255
        .TintAndShade = 0
    End With
' применение форматирование конец
' добавление графика
    Range("A1:B1").Select
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlBarOfPie
    ActiveChart.SetSourceData Source:=Range("Словарь!$A$1:$B$1")
    ActiveChart.SeriesCollection(1).Values = "=Словарь!$A$2:$A$20"
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(2).Name = "=Словарь!$B$1"
    ActiveChart.SeriesCollection(2).Values = "=Словарь!$B$2:$B$20"
    ActiveChart.SeriesCollection(2).XValues = "=Словарь!$B$2:$B$20"
    ActiveChart.ChartTitle.Select
    ActiveChart.ApplyLayout (6)
    ActiveChart.ChartTitle.Text = "ТОП20 униграмм в семантическом ядре"
    Selection.Format.TextFrame2.TextRange.Characters.Text = "ТОП20 униграмм в семантическом ядре"
    With Selection.Format.TextFrame2.TextRange.Characters(1, 14).ParagraphFormat
        .TextDirection = msoTextDirectionLeftToRight
        .Alignment = msoAlignCenter
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(1, 14).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    ActiveChart.ChartArea.Select
    ActiveSheet.Shapes("Диаграмма 1").ScaleWidth 1.48125, msoFalse, _
        msoScaleFromTopLeft
    ActiveSheet.Shapes("Диаграмма 1").ScaleHeight 1.4010414844, msoFalse, _
        msoScaleFromBottomRight
    ActiveSheet.Shapes("Диаграмма 1").ScaleHeight 1.1449815616, msoFalse, _
        msoScaleFromTopLeft
    ActiveSheet.Shapes("Диаграмма 1").ScaleWidth 1.0928271519, msoFalse, _
        msoScaleFromTopLeft
    ActiveChart.ChartGroups(1).SeriesLines.Select
    ActiveSheet.ChartObjects("Диаграмма 1").Activate
    ActiveChart.SeriesCollection(1).Points(19).Select
    ActiveSheet.ChartObjects("Диаграмма 1").Activate
    ActiveChart.SeriesCollection(1).Points(18).Select
    ActiveSheet.ChartObjects("Диаграмма 1").Activate
    ActiveChart.SeriesCollection(1).Points(17).Select
    ActiveSheet.ChartObjects("Диаграмма 1").Activate
    ActiveChart.SeriesCollection(1).Points(16).Select
    ActiveSheet.ChartObjects("Диаграмма 1").Activate
    ActiveChart.SeriesCollection(1).Points(15).Select
    ActiveSheet.ChartObjects("Диаграмма 1").Activate
    ActiveChart.SeriesCollection(1).Points(14).Select
    ActiveSheet.ChartObjects("Диаграмма 1").Activate
    ActiveChart.SeriesCollection(1).Points(13).Select
    ActiveSheet.ChartObjects("Диаграмма 1").Activate
    ActiveChart.SeriesCollection(1).Points(12).Select
    ActiveSheet.ChartObjects("Диаграмма 1").Activate
    ActiveChart.SeriesCollection(1).Points(11).Select
    ActiveSheet.ChartObjects("Диаграмма 1").Activate
    ActiveChart.SeriesCollection(1).Points(10).Select
    ActiveSheet.ChartObjects("Диаграмма 1").Activate
    ActiveChart.SeriesCollection(1).Points(9).Select
    ActiveSheet.ChartObjects("Диаграмма 1").Activate
    ActiveChart.SeriesCollection(1).Points(8).Select
    ActiveSheet.ChartObjects("Диаграмма 1").Activate
    ActiveChart.SeriesCollection(1).Points(7).Select
    ActiveSheet.ChartObjects("Диаграмма 1").Activate
    ActiveChart.SeriesCollection(1).Points(6).Select
    ActiveSheet.ChartObjects("Диаграмма 1").Activate
    ActiveChart.SeriesCollection(1).Points(5).Select
    ActiveSheet.ChartObjects("Диаграмма 1").Activate
    ActiveChart.SeriesCollection(1).Points(4).Select
    ActiveSheet.ChartObjects("Диаграмма 1").Activate
    ActiveChart.SeriesCollection(1).Points(3).Select
    ActiveSheet.ChartObjects("Диаграмма 1").Activate
    ActiveChart.SeriesCollection(1).Points(2).Select
    ActiveSheet.ChartObjects("Диаграмма 1").Activate
    ActiveChart.SeriesCollection(1).Points(1).Select
    ActiveSheet.ChartObjects("Диаграмма 1").Activate
    ActiveChart.SeriesCollection(1).Select
    ActiveSheet.ChartObjects("Диаграмма 1").Activate
    ActiveChart.SeriesCollection(2).Points(20).DataLabel.Select
    ActiveSheet.ChartObjects("Диаграмма 1").Activate
    ActiveChart.SeriesCollection(2).Points(19).DataLabel.Select
    ActiveSheet.ChartObjects("Диаграмма 1").Activate
    ActiveChart.SeriesCollection(2).Points(18).DataLabel.Select
    ActiveSheet.ChartObjects("Диаграмма 1").Activate
    ActiveChart.ChartArea.Select
    ActiveSheet.Shapes("Диаграмма 1").IncrementLeft -96.75
    ActiveSheet.Shapes("Диаграмма 1").IncrementTop 9
    ActiveWindow.SmallScroll Down:=-80
    ActiveChart.ClearToMatchStyle
    ActiveChart.ChartStyle = 10
    ActiveChart.ClearToMatchStyle
' добавление графика конец

   '  форматирование таблицы
       Columns("A:C").Select
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A:$C"), , xlYes).Name = _
        "Таблица5"
       Range("Таблица5[[#Headers],[Униграмма]]").Select
    Range("Таблица5[[#Headers],[Униграмма]]").AddComment
    Range("Таблица5[[#Headers],[Униграмма]]").Comment.Visible = True
    Range("Таблица5[[#Headers],[Униграмма]]").Comment.Text Text:= _
        "Униграмма (лемма)  - это исходная форма слова. "
    'Selection.ShapeRange.IncrementLeft -62.25
    'Selection.ShapeRange.IncrementTop 58.5
    '  форматирование таблицы
End Sub

Еще проблема в том, что ошибка рандомная - то есть, то нет!
не знаю даже куда копать(((
 
 
 
#2
11.01.2021 15:47:46
Добрый день!
Файл с примером приложите.
 
 
 
#3
11.01.2021 16:00:10
Цитата
Андрей_26 написал:
Файл с примером приложите.
 
 
 
#4
11.01.2021 16:11:05
mazersw, мой вам совет описать задачу решаемую макросом, не всегда хочется людям изучать чужой макрос иногда проще и быстрее написать новый)
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#5
11.01.2021 16:22:53
Цитата
mazersw написал:
ошибка рандомная - то есть, то нет
так может и таблица с именем "Таблица5" то есть, то нет? Когда есть - ошибка(т.к. нельзя создать две таблицы с одинаковым именем), когда нет - и ошибки нет. Попробуйте добавлять с рандомным именем:
Код
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A:$C"), , xlYes).Name = "NewTable" & ActiveSheet.ListObjects.Count + 1
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#6
12.01.2021 10:32:17
Ок попробую.  

Цитата
Mershik написал:  ...совет описать задачу решаемую макросом
Макрос - просто создает диаграмму (график) и применяет нужное форматирование, и все...
 
 
 
#7
12.01.2021 11:01:38
А может есть смысл позволить Excel самому имя таблицы придумать?
Код
With ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A:$C"), , xlYes)
    With .ListColumns("Униграмма").Range(1)
        .AddComment
        .Comment.Visible = True
        .Comment.Text Text:="Униграмма (лемма)  - это исходная форма слова. "
    End With
End With
 
 
 
Страницы: 1
Наверх