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

Вход

Регистрация

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

 

= Мир MS Excel/Расстановка картинок по-горизонтали - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Расстановка картинок по-горизонтали (Макросы/Sub)
Расстановка картинок по-горизонтали
Werwolfik Дата: Пятница, 09.02.2018, 06:20 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 15
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Всем доброго утра.
У меня есть макрос расположения картинок в ряд - по-вертикали, с растяжением их по ширине на 12 ячеек.
Как макросом осуществить подобную вставку картинок, но только по-горизонтали (с растяжением по высоте на 12 ячеек) ?
К сообщению приложен файл: 8835008.rar(34Kb)
 
Ответить
СообщениеВсем доброго утра.
У меня есть макрос расположения картинок в ряд - по-вертикали, с растяжением их по ширине на 12 ячеек.
Как макросом осуществить подобную вставку картинок, но только по-горизонтали (с растяжением по высоте на 12 ячеек) ?

Автор - Werwolfik
Дата добавления - 09.02.2018 в 06:20
Апострофф Дата: Пятница, 09.02.2018, 08:08 | Сообщение № 2
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 108
Репутация: 41 ±
Замечаний: 0% ±

Excel 2003
Werwolfik, Вы не в состоянии заменить Width на Height, пересчитывать картинкам не Top, а Left?
 
Ответить
СообщениеWerwolfik, Вы не в состоянии заменить Width на Height, пересчитывать картинкам не Top, а Left?

Автор - Апострофф
Дата добавления - 09.02.2018 в 08:08
perven Дата: Суббота, 10.02.2018, 07:27 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 43
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Werwolfik, код такой:

[vba]
Код

Sub Ìàêðîñ1()
  Óäàëèòü_ôèãóðû
    Dim fso As Object, fl As Object, f As Object, r As Long
    Set fso = CreateObject("Scripting.FileSystemObject")
     
    Dim T As Double, L As Double
    Dim sh
     
    Set fl = fso.GetFolder(ThisWorkbook.Path)
    T = Cells(4, 3).Left
    L = Cells(4, 3).Top
    For Each f In fl.Files
        If f.Name Like "*.jpg" Then
            Set sh = ActiveSheet.Shapes.AddPicture(f.Path, False, True, T, L, -1, -1)
            
            r = r + 1: Cells(r, 1) = sh.Height: Cells(r, 2) = sh.Width
            
            sh.Height = Range("4:25").Height
            
            r = r + 1: Cells(r, 1) = sh.Height: Cells(r, 2) = sh.Width
            r = r + 1: Cells(r, 1) = Cells(r - 1, 1) / Cells(r - 2, 1): Cells(r, 2) = Cells(r - 1, 2) / Cells(r - 2, 2)
            
            sh.Left = T
            sh.Top = L
            T = T + sh.Width
        End If
    Next f
End Sub
[/vba]


Сообщение отредактировал perven - Суббота, 10.02.2018, 07:29
 
Ответить
СообщениеWerwolfik, код такой:

[vba]
Код

Sub Ìàêðîñ1()
  Óäàëèòü_ôèãóðû
    Dim fso As Object, fl As Object, f As Object, r As Long
    Set fso = CreateObject("Scripting.FileSystemObject")
     
    Dim T As Double, L As Double
    Dim sh
     
    Set fl = fso.GetFolder(ThisWorkbook.Path)
    T = Cells(4, 3).Left
    L = Cells(4, 3).Top
    For Each f In fl.Files
        If f.Name Like "*.jpg" Then
            Set sh = ActiveSheet.Shapes.AddPicture(f.Path, False, True, T, L, -1, -1)
            
            r = r + 1: Cells(r, 1) = sh.Height: Cells(r, 2) = sh.Width
            
            sh.Height = Range("4:25").Height
            
            r = r + 1: Cells(r, 1) = sh.Height: Cells(r, 2) = sh.Width
            r = r + 1: Cells(r, 1) = Cells(r - 1, 1) / Cells(r - 2, 1): Cells(r, 2) = Cells(r - 1, 2) / Cells(r - 2, 2)
            
            sh.Left = T
            sh.Top = L
            T = T + sh.Width
        End If
    Next f
End Sub
[/vba]

Автор - perven
Дата добавления - 10.02.2018 в 07:27
Werwolfik Дата: Суббота, 10.02.2018, 08:06 | Сообщение № 4
Группа: Пользователи
Ранг: Новичок
Сообщений: 15
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Апострофф, ясно.
perven, спасибо за код.


Сообщение отредактировал Werwolfik - Суббота, 10.02.2018, 08:07
 
Ответить
СообщениеАпострофф, ясно.
perven, спасибо за код.

Автор - Werwolfik
Дата добавления - 10.02.2018 в 08:06
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Расстановка картинок по-горизонтали (Макросы/Sub)
Страница 1 из 11
Поиск:

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