Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Сообщение "Run-time error '1004' - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сообщение "Run-time error '1004' (Макросы/Sub)
Сообщение "Run-time error '1004'
OlegSmirnov Дата: Вторник, 27.02.2018, 05:52 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 67
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Здравствуйте.
Есть такой вопрос.

Макрос при вставке картинок на лист - выдает ошибку
"Run-time error '1004' Метод Paste из класса Worksheet завершен неверно."
И выделяет в коде слово "ActiveSheet.Paste".

Как это исправить ?

Код выглядит так:
[vba]
Код

Sub ВыводФотоФигур()

Dim itx As Long
    Application.ScreenUpdating = False
    For itx = ActiveSheet.Shapes.Count To 1 Step -1
        If Not Intersect(ActiveSheet.Shapes(itx).TopLeftCell, Columns("I:BJF")) Is Nothing Then
            ActiveSheet.Shapes(itx).Delete
        End If
    Next itx
    ActiveSheet.Range("I1:BJF50").ClearContents
  
        

    Dim Ws As Worksheet, i%, FR As Range, adr$, f$, a$, ms, str&, col&
    str = 2: col = 9
    For i = 5 To Cells(Rows.Count, 3).End(xlUp).Row
        f = Cells(i, 3).Value
        For Each Ws In Sheets
            If Ws.Name <> "Поиск" And Ws.Name <> "Лист4" Then
                Set FR = Ws.Cells.Find(f)
                If Not FR Is Nothing Then
                    Cells(str, col) = Ws.Name & "!" & FR.Address
                    Cells(str + 1, col) = FR
                    Макрос1 Cells(str, col).Value, col
                    col = col + 4
                    'adr = adr & " " & Ws.Name & "!" & FR.Address
                    '---цикл по следующим найденным ячейкам
                    a = FR.Address    '---запоминаем адрес первой найденной ячейки
                    Do
                        Set FR = Ws.Cells.FindNext(FR)
                        If FR.Address = a Then Exit Do
                        col = col + 4
                        Cells(str, col) = Ws.Name & "!" & FR.Address
                        Cells(str + 1, col) = FR
                        Макрос1 Cells(str, col).Value, col
                        'adr = adr & " " & Ws.Name & "!" & FR.Address
                    Loop
                    '-----------
                End If
                '                If adr <> "" Then
                '                    ms = Split(Mid(adr, 2, 1000))
                '                    Cells(i, 5).Resize(, UBound(ms) + 1) = ms
                '                End If
            End If
        Next
        'Cells(i, 5) = adr 'если в одну
        'если один адрес - одна ячейка
        'ms = Split(Mid(adr, 2, 1000))
        'Cells(i, 5).Resize(, UBound(ms) + 1) = ms
        '-------------------------
        'adr = ""
    Next
    
    Application.ScreenUpdating = True
    Range("A1").Select
End Sub

Sub Макрос1(ByVal adr As String, ByVal col As Long)
    'adr = Лист5.[i2]
    If adr = "" Then Exit Sub
    shi = Split(adr, "!")(0)
    Mn = 0
    Set cl = Range(adr) '[M16]
    clleft = cl.Left: cltop = cl.Top
    
    For Each Sh In Sheets(shi).Shapes
        shLeft = Sh.Left
        shtop = Sh.Top
        d = (Abs(clleft - shLeft) ^ 2 + Abs(cltop - shtop) ^ 2) ^ 0.5
        If Mn = 0 Then
        Mn = d: f = Sh.Name
        ElseIf Mn > d Then Mn = d: f = Sh.Name
        End If
    Next
    
    Лист22.Cells(1, col) = f
    
    Sheets(shi).Shapes(f).Copy  'Select
    Лист22.Cells(5, col).Select
    ActiveSheet.Paste
    
End Sub

Sub ОчисткаДиапазона()
Dim itx As Long
    Application.ScreenUpdating = False
    For itx = ActiveSheet.Shapes.Count To 1 Step -1
        If Not Intersect(ActiveSheet.Shapes(itx).TopLeftCell, Columns("I:BJF")) Is Nothing Then
            ActiveSheet.Shapes(itx).Delete
        End If
    Next itx
    ActiveSheet.Range("I1:BJF50").ClearContents
    End Sub

[/vba]


Сообщение отредактировал OlegSmirnov - Вторник, 27.02.2018, 05:53
 
Ответить
СообщениеЗдравствуйте.
Есть такой вопрос.

Макрос при вставке картинок на лист - выдает ошибку
"Run-time error '1004' Метод Paste из класса Worksheet завершен неверно."
И выделяет в коде слово "ActiveSheet.Paste".

Как это исправить ?

Код выглядит так:
[vba]
Код

Sub ВыводФотоФигур()

Dim itx As Long
    Application.ScreenUpdating = False
    For itx = ActiveSheet.Shapes.Count To 1 Step -1
        If Not Intersect(ActiveSheet.Shapes(itx).TopLeftCell, Columns("I:BJF")) Is Nothing Then
            ActiveSheet.Shapes(itx).Delete
        End If
    Next itx
    ActiveSheet.Range("I1:BJF50").ClearContents
  
        

    Dim Ws As Worksheet, i%, FR As Range, adr$, f$, a$, ms, str&, col&
    str = 2: col = 9
    For i = 5 To Cells(Rows.Count, 3).End(xlUp).Row
        f = Cells(i, 3).Value
        For Each Ws In Sheets
            If Ws.Name <> "Поиск" And Ws.Name <> "Лист4" Then
                Set FR = Ws.Cells.Find(f)
                If Not FR Is Nothing Then
                    Cells(str, col) = Ws.Name & "!" & FR.Address
                    Cells(str + 1, col) = FR
                    Макрос1 Cells(str, col).Value, col
                    col = col + 4
                    'adr = adr & " " & Ws.Name & "!" & FR.Address
                    '---цикл по следующим найденным ячейкам
                    a = FR.Address    '---запоминаем адрес первой найденной ячейки
                    Do
                        Set FR = Ws.Cells.FindNext(FR)
                        If FR.Address = a Then Exit Do
                        col = col + 4
                        Cells(str, col) = Ws.Name & "!" & FR.Address
                        Cells(str + 1, col) = FR
                        Макрос1 Cells(str, col).Value, col
                        'adr = adr & " " & Ws.Name & "!" & FR.Address
                    Loop
                    '-----------
                End If
                '                If adr <> "" Then
                '                    ms = Split(Mid(adr, 2, 1000))
                '                    Cells(i, 5).Resize(, UBound(ms) + 1) = ms
                '                End If
            End If
        Next
        'Cells(i, 5) = adr 'если в одну
        'если один адрес - одна ячейка
        'ms = Split(Mid(adr, 2, 1000))
        'Cells(i, 5).Resize(, UBound(ms) + 1) = ms
        '-------------------------
        'adr = ""
    Next
    
    Application.ScreenUpdating = True
    Range("A1").Select
End Sub

Sub Макрос1(ByVal adr As String, ByVal col As Long)
    'adr = Лист5.[i2]
    If adr = "" Then Exit Sub
    shi = Split(adr, "!")(0)
    Mn = 0
    Set cl = Range(adr) '[M16]
    clleft = cl.Left: cltop = cl.Top
    
    For Each Sh In Sheets(shi).Shapes
        shLeft = Sh.Left
        shtop = Sh.Top
        d = (Abs(clleft - shLeft) ^ 2 + Abs(cltop - shtop) ^ 2) ^ 0.5
        If Mn = 0 Then
        Mn = d: f = Sh.Name
        ElseIf Mn > d Then Mn = d: f = Sh.Name
        End If
    Next
    
    Лист22.Cells(1, col) = f
    
    Sheets(shi).Shapes(f).Copy  'Select
    Лист22.Cells(5, col).Select
    ActiveSheet.Paste
    
End Sub

Sub ОчисткаДиапазона()
Dim itx As Long
    Application.ScreenUpdating = False
    For itx = ActiveSheet.Shapes.Count To 1 Step -1
        If Not Intersect(ActiveSheet.Shapes(itx).TopLeftCell, Columns("I:BJF")) Is Nothing Then
            ActiveSheet.Shapes(itx).Delete
        End If
    Next itx
    ActiveSheet.Range("I1:BJF50").ClearContents
    End Sub

[/vba]

Автор - OlegSmirnov
Дата добавления - 27.02.2018 в 05:52
Апострофф Дата: Вторник, 27.02.2018, 10:50 | Сообщение № 2
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 156
Репутация: 56 ±
Замечаний: 0% ±

Excel 2003
OlegSmirnov, вряд ли кто нибудь по этой портянке без файла-примера сможет угадать, что творится на неком Лист22, что и куда копируется и т.д. и т.п..
Верните на место ScreenUpdating, выполнив[vba]
Код
Application.ScreenUpdating = TRUE
[/vba]и пройдите код пошагово([F8]).
Если вопросы останутся - приложите таки файл.
 
Ответить
СообщениеOlegSmirnov, вряд ли кто нибудь по этой портянке без файла-примера сможет угадать, что творится на неком Лист22, что и куда копируется и т.д. и т.п..
Верните на место ScreenUpdating, выполнив[vba]
Код
Application.ScreenUpdating = TRUE
[/vba]и пройдите код пошагово([F8]).
Если вопросы останутся - приложите таки файл.

Автор - Апострофф
Дата добавления - 27.02.2018 в 10:50
Michael_S Дата: Вторник, 27.02.2018, 12:10 | Сообщение № 3
Группа: Друзья
Ранг: Старожил
Сообщений: 1838
Репутация: 344 ±
Замечаний: 0% ±

Excel2016
А если так попробовать?
[vba]
Код
Sheets(shi).Shapes(f).Copy  Лист22.Cells(5, col)
[/vba]


ЯД: 41001136675053
WM: R389613894253
 
Ответить
СообщениеА если так попробовать?
[vba]
Код
Sheets(shi).Shapes(f).Copy  Лист22.Cells(5, col)
[/vba]

Автор - Michael_S
Дата добавления - 27.02.2018 в 12:10
OlegSmirnov Дата: Вторник, 27.02.2018, 23:12 | Сообщение № 4
Группа: Пользователи
Ранг: Участник
Сообщений: 67
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Апострофф, а как пошагово по F8 его пройти - там же около тысячи операций ?


Сообщение отредактировал OlegSmirnov - Среда, 28.02.2018, 07:44
 
Ответить
СообщениеАпострофф, а как пошагово по F8 его пройти - там же около тысячи операций ?

Автор - OlegSmirnov
Дата добавления - 27.02.2018 в 23:12
SLAVICK Дата: Среда, 28.02.2018, 11:17 | Сообщение № 5
Группа: Модераторы
Ранг: Старожил
Сообщений: 2240
Репутация: 744 ±
Замечаний: 0% ±

2007,2010,2013,2016
[vba]
Код
Sub d()
  Sheets(1).Shapes(1).Copy
  Sheets(2).Range("D4").PasteSpecial xlPasteAll
End Sub
[/vba]
К сообщению приложен файл: pic.xlsm(27.9 Kb)


Иногда все проще чем кажется с первого взгляда.
 
Ответить
Сообщение[vba]
Код
Sub d()
  Sheets(1).Shapes(1).Copy
  Sheets(2).Range("D4").PasteSpecial xlPasteAll
End Sub
[/vba]

Автор - SLAVICK
Дата добавления - 28.02.2018 в 11:17
OlegSmirnov Дата: Среда, 28.02.2018, 19:34 | Сообщение № 6
Группа: Пользователи
Ранг: Участник
Сообщений: 67
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Я все понял.
Всем спасибо за ответы.
 
Ответить
СообщениеЯ все понял.
Всем спасибо за ответы.

Автор - OlegSmirnov
Дата добавления - 28.02.2018 в 19:34
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Сообщение "Run-time error '1004' (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2018 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!