Форум программистов, компьютерный форум, киберфорум
Наши страницы
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.67/6: Рейтинг темы: голосов - 6, средняя оценка - 4.67
ДмитрийVBA
1 / 1 / 0
Регистрация: 18.04.2013
Сообщений: 27
1

Макрос вставки картинок и WEND. Где-то простая ошибка

30.04.2013, 10:33. Просмотров 1143. Ответов 2
Метки нет (Все метки)

Есть готовый макрос (источник:http://excelvba.ru/code/PastePictures), который вставляет картинку в ячейку с подгонкой размеров ячейки под размеры картинки.

Почему-то для некоторых картинок Excel зависает в цикле конструкции "While...Wend". После прерывания картинка иногда все-таки подгоняется по ширине, а вот по высоте - нет.

До запуска макроса надо распаковать все файлы в одну директорию.

PS: макрос вроде очень простой, а в чем ошибка понять никак не могу. С ума сойду сейчас.. Помогите, пожалуйста, разобраться. С меня респект и +к карме.

PPS: я начинающий..сильно не ругайте, пожалуйста..
0
Вложения
Тип файла: rar TEST.rar (38.7 Кб, 29 просмотров)
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
30.04.2013, 10:33
Ответы с готовыми решениями:

Макрос для автоматической вставки картинок из заданной папки в ворд
Доброй ночи. Кто может помочь в создании макроса. Суть такова: есть папка, в...

Макрос вставки файлов в листы-Необходимо изменить ниже приведённый макрос
Необходимо изменить ниже приведённый макрос, взятый с форума. Необходима...

Макрос поиска и вставки
Здравствуйте. Вопрос жизни и смерти....помогите пожалуйста.. Нужен макрос или...

Макрос сбора и вставки данных
Здравствуйте! Помогите пожалуйста с задачей. В течение всего дня мне в...

Макрос вставки изображений в Excel
Добрый день, уважаемые форумчане. Помогите, пожалуйста, с написанием макроса....

2
Аксима
5811 / 1261 / 187
Регистрация: 12.12.2012
Сообщений: 984
30.04.2013, 11:05 2
Здравствуйте, ДмитрийVBA,
Значения свойств .Width и .Height изменяются дискретно с определенным шагом, равным 0,75. Поэтому вам никогда, к примеру, не установить значение свойства .Width равным 100 с точностью 0,1 - самые близкие к этому значению значения свойства .Width, которые вы можете подобрать - это 99,75 и 100,5.

Мне кажется, нужно задать менее жесткие требования к точности подбора размеров ячейки:

Visual Basic
1
2
3
4
5
6
7
8
9
10
             While Abs(PicRange.Cells(1).Width - ph.Width) > 0.376    ' точный подбор ширины ячейки
                PicRange.Cells(1).ColumnWidth = PicRange.Cells(1).ColumnWidth - 0.2 * (PicRange.Cells(1).Width - ph.Width)
             Wend 'здесь проклятая ошибка =(
         End If
 
         If AdjustHeight Then    ' если AdjustHeight=TRUE, то ширину не трогаем - изменяем высоту
            PicRange.Cells(1).RowHeight = PicRange.Cells(1).RowHeight * ph.Height / PicRange.Cells(1).Height
             While Abs(PicRange.Cells(1).Height - ph.Height) > 0.376    ' точный подбор высоты ячейки
                PicRange.Cells(1).RowHeight = PicRange.Cells(1).RowHeight - 0.2 * (PicRange.Cells(1).Height - ph.Height)
             Wend
С уважением,
Aksima
1
ДмитрийVBA
1 / 1 / 0
Регистрация: 18.04.2013
Сообщений: 27
30.04.2013, 11:29  [ТС] 3
Цитата Сообщение от Aksima Посмотреть сообщение
Здравствуйте, ДмитрийVBA,
Значения свойств .Width и .Height изменяются дискретно с определенным шагом, равным 0,75. Поэтому вам никогда, к примеру, не установить значение свойства .Width равным 100 с точностью 0,1 - самые близкие к этому значению значения свойства .Width, которые вы можете подобрать - это 99,75 и 100,5.

Мне кажется, нужно задать менее жесткие требования к точности подбора размеров ячейки:

Visual Basic
1
2
3
4
5
6
7
8
9
10
             While Abs(PicRange.Cells(1).Width - ph.Width) > 0.376    ' точный подбор ширины ячейки
                PicRange.Cells(1).ColumnWidth = PicRange.Cells(1).ColumnWidth - 0.2 * (PicRange.Cells(1).Width - ph.Width)
             Wend 'здесь проклятая ошибка =(
         End If
 
         If AdjustHeight Then    ' если AdjustHeight=TRUE, то ширину не трогаем - изменяем высоту
            PicRange.Cells(1).RowHeight = PicRange.Cells(1).RowHeight * ph.Height / PicRange.Cells(1).Height
             While Abs(PicRange.Cells(1).Height - ph.Height) > 0.376    ' точный подбор высоты ячейки
                PicRange.Cells(1).RowHeight = PicRange.Cells(1).RowHeight - 0.2 * (PicRange.Cells(1).Height - ph.Height)
             Wend
С уважением,
Aksima
Вот же ж я дурак..как всегда стыдно... Просто и гениально! Премного благодарен! Будьте счастливы!
0
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
30.04.2013, 11:29

Макрос вставки изображений в листы книги
Добрый день, уважаемые форумчане! Помогите написать макрос. Есть папка с...

Макрос для вставки макроса в Excel
Собственно, вопрос в названии. Можно ли написать макрос, который будет...

Макрос вставки столбцов в нескольких таблицах
Уважаемые форумчане, прошу Вашей помощи. Можно ли сделать макрос вставки...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
3
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru