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

Вход

Регистрация

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

 

= Мир MS Excel/Вставка картинки, если нет картинки - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Вставка картинки, если нет картинки (Макросы/Sub)
Вставка картинки, если нет картинки
rastr Дата: Понедельник, 10.06.2019, 12:26 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Добрый день!
Помогите допилить макрос.
Нужно вставить картинку в ячейку эксель, и в принципе все работает, только вот если нет картинки выдает ошибку, а нужно чтобы пропускал, сейчас в коде вставка только одной картинки, а их будет 26 и если хотя бы одной нет он не работает как сделать условие чтобы пропускал ячейки для которых еще нет фото.
[vba]
Код

Sub Макрос2()
' Макрос2 Макрос
ActiveWindow.Zoom = 100

ActiveSheet.Pictures.Insert( _
"\\################\1 (1).jpeg" _
).Select

With Selection.ShapeRange
.LockAspectRatio = False
.Width = Range("j13").Width
.Height = Range("j13").Height
.Top = Range("j13").Top
.Left = Range("j13").Left + (Range("j13").Width - .Width) / 2
End With
End Sub
[/vba]
К сообщению приложен файл: 7279245.xlsm(33.9 Kb)


Сообщение отредактировал rastr - Понедельник, 10.06.2019, 15:43
 
Ответить
СообщениеДобрый день!
Помогите допилить макрос.
Нужно вставить картинку в ячейку эксель, и в принципе все работает, только вот если нет картинки выдает ошибку, а нужно чтобы пропускал, сейчас в коде вставка только одной картинки, а их будет 26 и если хотя бы одной нет он не работает как сделать условие чтобы пропускал ячейки для которых еще нет фото.
[vba]
Код

Sub Макрос2()
' Макрос2 Макрос
ActiveWindow.Zoom = 100

ActiveSheet.Pictures.Insert( _
"\\################\1 (1).jpeg" _
).Select

With Selection.ShapeRange
.LockAspectRatio = False
.Width = Range("j13").Width
.Height = Range("j13").Height
.Top = Range("j13").Top
.Left = Range("j13").Left + (Range("j13").Width - .Width) / 2
End With
End Sub
[/vba]

Автор - rastr
Дата добавления - 10.06.2019 в 12:26
_Boroda_ Дата: Понедельник, 10.06.2019, 12:30 | Сообщение № 2
Группа: Модераторы
Ранг: Местный житель
Сообщений: 15268
Репутация: 5991 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Код нужно вставлять между тегами

[vbа][cоde]Вот сюда[/cоde][/vbа]

Исправьте у себя в сообщении
Да, и
- Прочитайте Правила форума
- Исправьте название темы согласно п.2 Правил форума, конкретнее обозначьте проблему


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеКод нужно вставлять между тегами

[vbа][cоde]Вот сюда[/cоde][/vbа]

Исправьте у себя в сообщении
Да, и
- Прочитайте Правила форума
- Исправьте название темы согласно п.2 Правил форума, конкретнее обозначьте проблему

Автор - _Boroda_
Дата добавления - 10.06.2019 в 12:30
_Boroda_ Дата: Понедельник, 10.06.2019, 16:09 | Сообщение № 3
Группа: Модераторы
Ранг: Местный житель
Сообщений: 15268
Репутация: 5991 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Попробуйте использовать
[vba]
Код
on error resume next
[/vba]
[vba]
Код
Sub Макрос2()
    ActiveWindow.Zoom = 100
    On Error Resume Next 'пропуск ошибок
    For i = 1 To 26 'это типа цикл, я не знаю как Вам на самом деле нужно
        ActiveSheet.Pictures.Insert( _
            "\\ukkalita.local\iptg\Дивизион управления недвижимостью\Департамент эксплуатации объектов недвижимости\Служба Эксплуатации\ППР\КОТЛЯКОВКА, ТАГАНКА\фото\Котляковка\2019\2 кв\1 (5).jpeg" _
                ).Select
        If Not Err Then 'если ошибки нет
            With Selection.ShapeRange
                .LockAspectRatio = False
                .Width = Range("j13").Width
                .Height = Range("j13").Height
                .Top = Range("j13").Top
                .Left = Range("j13").Left + (Range("j13").Width - .Width) / 2
            End With
        End If
        Err.Clear 'сброс ошибки
    Next i
    On Error GoTo 0 'сброс пропуска ошибки (если ниже еще что-то будет, если не будет, то все само сбросится на End Sub)
End Sub
[/vba]


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеПопробуйте использовать
[vba]
Код
on error resume next
[/vba]
[vba]
Код
Sub Макрос2()
    ActiveWindow.Zoom = 100
    On Error Resume Next 'пропуск ошибок
    For i = 1 To 26 'это типа цикл, я не знаю как Вам на самом деле нужно
        ActiveSheet.Pictures.Insert( _
            "\\ukkalita.local\iptg\Дивизион управления недвижимостью\Департамент эксплуатации объектов недвижимости\Служба Эксплуатации\ППР\КОТЛЯКОВКА, ТАГАНКА\фото\Котляковка\2019\2 кв\1 (5).jpeg" _
                ).Select
        If Not Err Then 'если ошибки нет
            With Selection.ShapeRange
                .LockAspectRatio = False
                .Width = Range("j13").Width
                .Height = Range("j13").Height
                .Top = Range("j13").Top
                .Left = Range("j13").Left + (Range("j13").Width - .Width) / 2
            End With
        End If
        Err.Clear 'сброс ошибки
    Next i
    On Error GoTo 0 'сброс пропуска ошибки (если ниже еще что-то будет, если не будет, то все само сбросится на End Sub)
End Sub
[/vba]

Автор - _Boroda_
Дата добавления - 10.06.2019 в 16:09
rastr Дата: Вторник, 11.06.2019, 17:03 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Добрый день!
К сожалению без назначения переменной не получается программа работает, но некоторые картинки вставляются не в свои ячейки (например картинка 1 (5) улетает в ячейку J51
А если делать через
переменную
For i = 1 To 26 пока остановился вставке 7 картинок
выдает ошибку, хотя может я не правильно вызываю переменную.
[vba]
Код
Sub Макрос2()
' Макрос2 Макрос
ActiveWindow.Zoom = 100

' 1 картинка
On Error Resume Next 'пропуск ошибок
For i = 1 To 7
ActiveSheet.Pictures.Insert( _
    "\\ukkalita.local\iptg\Дивизион управления недвижимостью\Департамент эксплуатации объектов недвижимости\Служба Эксплуатации\ППР\КОТЛЯКОВКА, ТАГАНКА\фото\Котляковка\2019\2 кв\1 (1).jpeg" _
        ).Select
If Not Err Then
With Selection.ShapeRange
.LockAspectRatio = False
       .Width = Range("j13").Width
       .Height = Range("j13").Height
       .Top = Range("j13").Top
       .Left = Range("j13").Left + (Range("j13").Width - .Width) / 2
End With
End If
    Err.Clear
    Next i
    On Error GoTo 0
    ' 2 картинка

On Error Resume Next
ActiveSheet.Pictures.Insert( _
    "\\ukkalita.local\iptg\Дивизион управления недвижимостью\Департамент эксплуатации объектов недвижимости\Служба Эксплуатации\ППР\КОТЛЯКОВКА, ТАГАНКА\фото\Котляковка\2019\2 кв\1 (2).jpeg" _
        ).Select
If Not Err Then
With Selection.ShapeRange
       .LockAspectRatio = False
       .Width = Range("j14").Width
       .Height = Range("j14").Height
       .Top = Range("j14").Top
       .Left = Range("j14").Left + (Range("j14").Width - .Width) / 2
End With
End If
Err.Clear
    Next i
    On Error GoTo 0
' 5 картинка

On Error Resume Next
ActiveSheet.Pictures.Insert( _
    "\\ukkalita.local\iptg\Дивизион управления недвижимостью\Департамент эксплуатации объектов недвижимости\Служба Эксплуатации\ППР\КОТЛЯКОВКА, ТАГАНКА\фото\Котляковка\2019\2 кв\1 (5).jpeg" _
        ).Select
If Not Err Then
With Selection.ShapeRange
.LockAspectRatio = False
       .Width = Range("j15").Width
       .Height = Range("j15").Height
       .Top = Range("j15").Top
       .Left = Range("j15").Left + (Range("j15").Width - .Width) / 2
End With
End If
Err.Clear
    Next i
    On Error GoTo 0
' 17 картинка

On Error Resume Next
ActiveSheet.Pictures.Insert( _
    "\\ukkalita.local\iptg\Дивизион управления недвижимостью\Департамент эксплуатации объектов недвижимости\Служба Эксплуатации\ППР\КОТЛЯКОВКА, ТАГАНКА\фото\Котляковка\2019\2 кв\1 (17).jpeg" _
        ).Select
If Not Err Then
With Selection.ShapeRange
.LockAspectRatio = False
       .Width = Range("j50").Width
       .Height = Range("j50").Height
       .Top = Range("j50").Top
       .Left = Range("j50").Left + (Range("j50").Width - .Width) / 2
End With
End If
Err.Clear
    Next i
    On Error GoTo 0
' 18 картинка

On Error Resume Next
ActiveSheet.Pictures.Insert( _
    "\\ukkalita.local\iptg\Дивизион управления недвижимостью\Департамент эксплуатации объектов недвижимости\Служба Эксплуатации\ППР\КОТЛЯКОВКА, ТАГАНКА\фото\Котляковка\2019\2 кв\1 (18).jpeg" _
        ).Select
If Not Err Then
With Selection.ShapeRange
.LockAspectRatio = False
       .Width = Range("j51").Width
       .Height = Range("j51").Height
       .Top = Range("j51").Top
       .Left = Range("j51").Left + (Range("j51").Width - .Width) / 2
End With
End If
Err.Clear
    Next i
    On Error GoTo 0
' 19 картинка
On Error Resume Next
ActiveSheet.Pictures.Insert( _
    "\\ukkalita.local\iptg\Дивизион управления недвижимостью\Департамент эксплуатации объектов недвижимости\Служба Эксплуатации\ППР\КОТЛЯКОВКА, ТАГАНКА\фото\Котляковка\2019\2 кв\1 (19).jpeg" _
        ).Select
If Not Err Then
With Selection.ShapeRange
.LockAspectRatio = False
       .Width = Range("j53").Width
       .Height = Range("j53").Height
       .Top = Range("j53").Top
       .Left = Range("j53").Left + (Range("j53").Width - .Width) / 2
End With
End If
Err.Clear
    Next i
    On Error GoTo 0
' 20 картинка
On Error Resume Next
ActiveSheet.Pictures.Insert( _
    "\\ukkalita.local\iptg\Дивизион управления недвижимостью\Департамент эксплуатации объектов недвижимости\Служба Эксплуатации\ППР\КОТЛЯКОВКА, ТАГАНКА\фото\Котляковка\2019\2 кв\1 (20).jpeg" _
        ).Select
If Not Err Then
With Selection.ShapeRange
.LockAspectRatio = False
       .Width = Range("j54").Width
       .Height = Range("j54").Height
       .Top = Range("j54").Top
       .Left = Range("j54").Left + (Range("j54").Width - .Width) / 2
End With
End If
Err.Clear

End Sub
[/vba]
К сообщению приложен файл: 8276923.xlsm(34.4 Kb)
 
Ответить
СообщениеДобрый день!
К сожалению без назначения переменной не получается программа работает, но некоторые картинки вставляются не в свои ячейки (например картинка 1 (5) улетает в ячейку J51
А если делать через
переменную
For i = 1 To 26 пока остановился вставке 7 картинок
выдает ошибку, хотя может я не правильно вызываю переменную.
[vba]
Код
Sub Макрос2()
' Макрос2 Макрос
ActiveWindow.Zoom = 100

' 1 картинка
On Error Resume Next 'пропуск ошибок
For i = 1 To 7
ActiveSheet.Pictures.Insert( _
    "\\ukkalita.local\iptg\Дивизион управления недвижимостью\Департамент эксплуатации объектов недвижимости\Служба Эксплуатации\ППР\КОТЛЯКОВКА, ТАГАНКА\фото\Котляковка\2019\2 кв\1 (1).jpeg" _
        ).Select
If Not Err Then
With Selection.ShapeRange
.LockAspectRatio = False
       .Width = Range("j13").Width
       .Height = Range("j13").Height
       .Top = Range("j13").Top
       .Left = Range("j13").Left + (Range("j13").Width - .Width) / 2
End With
End If
    Err.Clear
    Next i
    On Error GoTo 0
    ' 2 картинка

On Error Resume Next
ActiveSheet.Pictures.Insert( _
    "\\ukkalita.local\iptg\Дивизион управления недвижимостью\Департамент эксплуатации объектов недвижимости\Служба Эксплуатации\ППР\КОТЛЯКОВКА, ТАГАНКА\фото\Котляковка\2019\2 кв\1 (2).jpeg" _
        ).Select
If Not Err Then
With Selection.ShapeRange
       .LockAspectRatio = False
       .Width = Range("j14").Width
       .Height = Range("j14").Height
       .Top = Range("j14").Top
       .Left = Range("j14").Left + (Range("j14").Width - .Width) / 2
End With
End If
Err.Clear
    Next i
    On Error GoTo 0
' 5 картинка

On Error Resume Next
ActiveSheet.Pictures.Insert( _
    "\\ukkalita.local\iptg\Дивизион управления недвижимостью\Департамент эксплуатации объектов недвижимости\Служба Эксплуатации\ППР\КОТЛЯКОВКА, ТАГАНКА\фото\Котляковка\2019\2 кв\1 (5).jpeg" _
        ).Select
If Not Err Then
With Selection.ShapeRange
.LockAspectRatio = False
       .Width = Range("j15").Width
       .Height = Range("j15").Height
       .Top = Range("j15").Top
       .Left = Range("j15").Left + (Range("j15").Width - .Width) / 2
End With
End If
Err.Clear
    Next i
    On Error GoTo 0
' 17 картинка

On Error Resume Next
ActiveSheet.Pictures.Insert( _
    "\\ukkalita.local\iptg\Дивизион управления недвижимостью\Департамент эксплуатации объектов недвижимости\Служба Эксплуатации\ППР\КОТЛЯКОВКА, ТАГАНКА\фото\Котляковка\2019\2 кв\1 (17).jpeg" _
        ).Select
If Not Err Then
With Selection.ShapeRange
.LockAspectRatio = False
       .Width = Range("j50").Width
       .Height = Range("j50").Height
       .Top = Range("j50").Top
       .Left = Range("j50").Left + (Range("j50").Width - .Width) / 2
End With
End If
Err.Clear
    Next i
    On Error GoTo 0
' 18 картинка

On Error Resume Next
ActiveSheet.Pictures.Insert( _
    "\\ukkalita.local\iptg\Дивизион управления недвижимостью\Департамент эксплуатации объектов недвижимости\Служба Эксплуатации\ППР\КОТЛЯКОВКА, ТАГАНКА\фото\Котляковка\2019\2 кв\1 (18).jpeg" _
        ).Select
If Not Err Then
With Selection.ShapeRange
.LockAspectRatio = False
       .Width = Range("j51").Width
       .Height = Range("j51").Height
       .Top = Range("j51").Top
       .Left = Range("j51").Left + (Range("j51").Width - .Width) / 2
End With
End If
Err.Clear
    Next i
    On Error GoTo 0
' 19 картинка
On Error Resume Next
ActiveSheet.Pictures.Insert( _
    "\\ukkalita.local\iptg\Дивизион управления недвижимостью\Департамент эксплуатации объектов недвижимости\Служба Эксплуатации\ППР\КОТЛЯКОВКА, ТАГАНКА\фото\Котляковка\2019\2 кв\1 (19).jpeg" _
        ).Select
If Not Err Then
With Selection.ShapeRange
.LockAspectRatio = False
       .Width = Range("j53").Width
       .Height = Range("j53").Height
       .Top = Range("j53").Top
       .Left = Range("j53").Left + (Range("j53").Width - .Width) / 2
End With
End If
Err.Clear
    Next i
    On Error GoTo 0
' 20 картинка
On Error Resume Next
ActiveSheet.Pictures.Insert( _
    "\\ukkalita.local\iptg\Дивизион управления недвижимостью\Департамент эксплуатации объектов недвижимости\Служба Эксплуатации\ППР\КОТЛЯКОВКА, ТАГАНКА\фото\Котляковка\2019\2 кв\1 (20).jpeg" _
        ).Select
If Not Err Then
With Selection.ShapeRange
.LockAspectRatio = False
       .Width = Range("j54").Width
       .Height = Range("j54").Height
       .Top = Range("j54").Top
       .Left = Range("j54").Left + (Range("j54").Width - .Width) / 2
End With
End If
Err.Clear

End Sub
[/vba]

Автор - rastr
Дата добавления - 11.06.2019 в 17:03
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Вставка картинки, если нет картинки (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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