whitemanehorsey (Автор тем)

Как реализовать массовую вставку картинок в прайс-лист в соответствии с артикулами и с сохранением пропорций

Пользователь

Сообщений: 32 Регистрация: 24.07.2018

09.10.2018 23:00:19

Здравствуйте, уважаемые эксперты! С учетом всех замечаний позвольте мне исправиться. Помогите пожалуйста решить такую задачу:
Есть файл (во вложении price.xls). Это прайс-лист. В нем, в графе "ITEM NO." указаны артикулы товаров. Также в комплекте с этим прайсом идет папка с фотографиями (пример во вложении pict.zip). Имена файлов изображений в этой папке соответствуют артикулам товаров. Размеры у изображений разные. Нужно вставить изображения из этой папки в прайс-лист в графу "Item Photos" в соответствии с артикулами в графе "ITEM NO.", при этом уменьшив эти изображения до приемлемого для прайс-листа размера 100 по высоте с сохранением пропорций по ширине и подогнав высоту строки под высоту этих изображений.

Изменено: whitemanehorsey - 10.10.2018 15:06:44

Перейти

Метод Shapes.AddPicture (Excel) - как сохранить пропорции изображения?

whitemanehorsey

Пользователь

Сообщений: 32 Регистрация: 24.07.2018

03.09.2018 18:28:46

Снова здравствуйте, дорогие эксперты!
Предыдущую тему я и назвал неверно, и сформулировал расплывчато, за что прошу прощения и конкретизирую вопрос:
Как при использовании метода Shapes.AddPicture сохранить пропорции изображения при его уменьшении?

Пример строки:

Код
Set sShape = ActiveSheet.Shapes.AddPicture(PicList(lLoop), msoFalse, msoCTrue, Rng.Left, Rng.Top, Rng.Width, Rng.Height)

Пример скрипта:

Код

Sub InsertPictures()
'Update 20140513
Dim PicList() As Variant
Dim PicFormat As String
Dim Rng As Range
Dim sShape As Shape
On Error Resume Next
PicList = Application.GetOpenFilename(PicFormat, MultiSelect:=True)
xColIndex = Application.ActiveCell.Column
If IsArray(PicList) Then
    xRowIndex = Application.ActiveCell.Row
    For lLoop = LBound(PicList) To UBound(PicList)
        Set Rng = Cells(xRowIndex, xColIndex)
        Set sShape = ActiveSheet.Shapes.AddPicture(PicList(lLoop), msoFalse, msoCTrue, Rng.Left, Rng.Top, Rng.Width, Rng.Height)
        xRowIndex = xRowIndex + 1
    Next
End If
End Sub

Перейти

Excel 2016 не открывает штрих-коды, Проблема со штрих-кодами в Excel

whitemanehorsey

Пользователь

Сообщений: 32 Регистрация: 24.07.2018

24.07.2018 17:04:43

Добрый день, уважаемые эксперты форума! Обращаюсь к вам впервые, т.к. раньше ответы удавалось найти в уже существующих темах. Но не в этот раз. Проблема в следующем:

Присылает нам поставщик накладные, предположительно, из 1С. На всех компах, кроме новых, они открываются корректно, а на новых стоит MS Office 2016 (лицензия) и вместо штрих-кода открывается набор символов. Шрифт в систему установлен. В Word 2016 все работает. А в Excel 2016 даже вручную назначить этот шрифт не дает. При этом, в MS Office 2003 (лицензия) открывается все без проблем. Переставить офис на старый не вариант, ибо все лицензия на определенное количество машин. Все настройки безопасности отключали - не помогает. Отправил друзьям - выяснилось, что проблема на всех машинах с офисом 2016. При этом, другие штрих-коды открываются без проблем. Проблема в том, что в данном документе штрих-код в отдельном модуле, а Excel 2016 по какой-то причине не позволяет ставить в "Надписях" нестандартные шрифты. Может кто с этим сталкивался? Файлы прилагаю: в архиве пример файла и шрифт.

Перейти