Форум программистов
 
О проблемах, например, с регистрацией пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail, а тут можно восстановить пароль.

Вернуться   Форум программистов > Microsoft Office и VBA > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Здесь нужно купить рекламу за 20 тыс руб в месяц! ) пишите сюда - alarforum@yandex.ru
Без учёта ботов - 20000 человек в день, 350000 в месяц.

Ответ
 
Опции темы
Старый 22.05.2020, 15:20   #1
Вадим12091965
Форумчанин
 
Регистрация: 21.10.2012
Сообщений: 116
По умолчанию Редактирование кода для поиска картинок

Здравствуйте. Когда-то использовал код для формы (образец прилагаю). Сейчас тоже будет форма, но данные будут с листа «Введение»: название системы – ячейка Е5; название картинки - ячейка Е6. Можно усовершенствовать код, чтобы был поиск папки с названием, соответствующим тексту ячейки Е5 и в этой папке поиск картинки, соответствующей тексту ячейки Е6. Папки с картинками будут находиться рядом с книгой Excel. Это, если возможно, то значительно сократит код.

Код:
Private Sub TextBox36_Change()
        Dim ImageLDSPPath As String
        ImageLDSPPath = ThisWorkbook.Path & "\ImageLDSP\"
        If TextBox36.Text = "Бук Бавария" And IsExists(ImageLDSPPath & "Бук Бавария D 9200.jpg") Then
                Image3.Picture = LoadPicture(ImageLDSPPath & "Бук Бавария D 9200.jpg")
        End If
        If TextBox36.Text = "Вишня Оксфорд" And IsExists(ImageLDSPPath & "Вишня Оксфорд D 088.jpg") Then
                Image3.Picture = LoadPicture(ImageLDSPPath & "Вишня Оксфорд D 088.jpg")
        End If
        If TextBox36.Text = "Орех Ноче Экко" And IsExists(ImageLDSPPath & "Орех Экко D 2251.jpg") Then
                Image3.Picture = LoadPicture(ImageLDSPPath & "Орех Экко D 2251.jpg")
        End If
End Sub
Это маленький кусочек большого кода. Просьба помочь. Спасибо
Вадим12091965 вне форума Ответить с цитированием
Старый 22.05.2020, 16:13   #2
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 2,834
По умолчанию

Код:
ImageLDSPPath = ThisWorkbook.Path & "\" & Sheets("Введение").Range("E5") & "\"
dim ImageName as string: ImageName = Sheets("Введение").Range("E6")

        If TextBox36.Text = "Бук Бавария" And IsExists(ImageLDSPPath & ImageName ) Then
                Image3.Picture = LoadPicture(ImageLDSPPath & ImageName )
        End If
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 22.05.2020, 18:42   #3
Вадим12091965
Форумчанин
 
Регистрация: 21.10.2012
Сообщений: 116
По умолчанию

Спасибо, что ответили. Я с выложенным кодом вас запутал. Прикладываю файл. Пишу пошагово что планируется:
1. Вызываем кнопкой на листе UserForm1
2. Выбираем из выпадающего списка в ячейке Е5 Тип системы – это имя папки, которую ищет макрос.
3. Выбираем из выпадающего списка в ячейке Е6 Тип вертикального профиля – это имя картинки, которую макрос ищет в нашедшей папке.
4. Найденная картинка размещается в UserForm1 на Image7.
Прикрепил 2 папки. В каждой по 1-й картинке для теста. Просьба код написать целиком и расположить его где он должен располагаться. Сам точно не сделаю, поэтому и прошу о помощи. Спасибо
Вложения
Тип файла: zip Тест.zip (527.8 Кб, 1 просмотров)
Вадим12091965 вне форума Ответить с цитированием
Старый 22.05.2020, 22:56   #4
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 2,834
По умолчанию

В общих чертах можно так сделать
Вложения
Тип файла: zip Тест.zip (526.8 Кб, 1 просмотров)
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 23.05.2020, 05:50   #5
Вадим12091965
Форумчанин
 
Регистрация: 21.10.2012
Сообщений: 116
По умолчанию

Здравствуйте. Дай бог вам здоровья и чтобы все вирусы прошли от вас стороной.
Вадим12091965 вне форума Ответить с цитированием
Старый 23.05.2020, 06:29   #6
Вадим12091965
Форумчанин
 
Регистрация: 21.10.2012
Сообщений: 116
По умолчанию

Перенёс ваш код в рабочую книгу, выдаётся ошибка, что что-то не так с FormRefresh
Вложения
Тип файла: zip Расчёт дверей.zip (668.8 Кб, 0 просмотров)
Вадим12091965 вне форума Ответить с цитированием
Старый 23.05.2020, 06:54   #7
Вадим12091965
Форумчанин
 
Регистрация: 21.10.2012
Сообщений: 116
По умолчанию

Сам ступил. Код который на форме не скопировал. Всё хорошо. Спасибо
Вадим12091965 вне форума Ответить с цитированием
Старый 23.05.2020, 07:40   #8
Вадим12091965
Форумчанин
 
Регистрация: 21.10.2012
Сообщений: 116
По умолчанию

Начал прописывать заполнение ListBox3 и столкнулся с проблемой

Код:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Set KeyCells = Sheets("Введение").Range("E5:E6")
    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
        Is Nothing And UserForm1.Visible Then
            UserForm1.FormRefresh
    End If
    If Sheets("Введение").Range("E5") = "" Then
    UserForm1.ListBox3.Text = "Выберите Тип системы"
    End If
End Sub
Или для ListBox нужно код не здесь?
Вадим12091965 вне форума Ответить с цитированием
Старый 23.05.2020, 09:31   #9
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 2,834
По умолчанию

Все проверки на корректность заполнения надо делать в первом блоке if, перед FormRefresh. FormRefresh вызывается только если все условия ок
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 23.05.2020, 10:48   #10
Вадим12091965
Форумчанин
 
Регистрация: 21.10.2012
Сообщений: 116
По умолчанию

Я безнадёжен. Не могу сообразить как "если-то" можно вставить в другой "если-то", тем более, что условий будет много
Вадим12091965 вне форума Ответить с цитированием
Ответ

Здесь нужно купить рекламу за 20 тыс руб в месяц! ) пишите сюда - alarforum@yandex.ru
Без учёта ботов - 20000 человек в день, 350000 в месяц.

Опции темы


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Редактирование после поиска TYMON C++ Builder 3 18.05.2015 19:32
Редактирование имеющегося кода. Romeos Помощь студентам 0 23.11.2012 16:34
Редактирование HTML кода xpams Работа с сетью в Delphi 2 08.01.2012 12:33
Новичок в С++. Редактирование задачи (кода) Mc_Shake Помощь студентам 1 09.09.2011 22:05
скрипт поиска картинок vaneeeek PHP 0 10.08.2011 11:58


Проекты отопления, пеллетные котлы, бойлеры, радиаторы
интернет магазин respective.ru
Пеллетный котёл Emtas
котлы EMTAS