Как вывести полное имя файла рисунка - VBA
Формулировка задачи:
Реализовать интерфейс с объектами, представленными на рисунке. Для кнопок CommandButton1 и CommandButton2 загружаются изображения при инициализации формы UserForm1. При нажатии на кнопку с помощью меток Label1 и Label2 выводится полное имя файла рисунка.
Решение задачи: «Как вывести полное имя файла рисунка»
textual
Листинг программы
- 'Ïðè ïåðâîì Г§Г*ГЇГіГ±ГЄГҐ ôîðìû ôîðìèðóåì ñîñòГ*Гў çîîïГ*ðêГ*.
- Private Sub UserForm_Initialize()
- Dim oIE As Object, oIEDoc As Object, oElems As Object, oAnc As Object
- Dim oHTTP As Object, oStream As Object, oCB As Object
- Dim animals() As String, animalColl As New Collection
- Dim urls As Variant, lnk As Variant
- Dim i As Long, n As Long, newi As Long
- Dim t As String, p As String, picName As String
- On Error Resume Next
- Set oIE = CreateObject("InternetExplorer.Application")
- On Error GoTo 0
- If oIE Is Nothing Then
- MsgBox "ÈçâèГ*ГЁГІГҐ, Г*Г® äëÿ Г°Г*áîòû Г¤Г*Г*Г*îãî Г¬Г*êðîñГ* ГўГ*Г¬ ïðèäåòñÿ ГіГ±ГІГ*Г*îâèòü Internet Explorer."
- Unload Me
- Exit Sub
- End If
- urls = Array( _
- "https://www.google.ru/search?q=%D0%BC%D0%BB%D0%B5%D0%BA%D0%BE%D0%BF%D0%B8%D1%82%D0%B0%D1%8E%D1%89%D0%B8%D0%B5+%D0%B6%D0%B8%D0%B2%D0%BE%D1%82%D0%BD%D1%8B%D0%B5&tbm=isch", _
- "https://www.google.ru/search?q=%D0%BF%D1%82%D0%B8%D1%86%D1%8B&tbm=isch", _
- "https://www.google.ru/search?q=%D1%80%D1%8B%D0%B1%D1%8B&tbm=isch") 'Ññûëêè Г*Г* ïîèñê ÷åðåç Google ГЄГ*ðòèГ*îê - ìëåêîïèòГ*ГѕГ№ГЁГµ, ГЇГІГЁГ¶ ГЁ ðûá.
- For i = 0 To 2
- oIE.Navigate urls(i) 'Ãóãëèì ГЄГ*ðòèГ*ГЄГЁ ÷åðåç Internet Explorer.
- While oIE.Busy Or oIE.ReadyState < 4 'Æäåì, ïîêГ* ГўГҐГЎ-Г±ГІГ°Г*Г*ГЁГ¶Г* Г§Г*ãðóçèòñÿ.
- DoEvents
- Wend
- Set oIEDoc = oIE.Document
- Set oElems = oIEDoc.getElementsByClassName("rg_l")
- For Each oAnc In oElems 'Äëÿ ГЄГ*æäîãî èçîáðГ*æåГ*ГЁГї-ãèïåðññûëêè Г*Г* Г±ГІГ°Г*Г*èöå...
- i = i + 1
- lnk = oAnc.getAttribute("href") 'a) ïîëó÷Г*ГҐГ¬ Г§Г*Г*Г·ГҐГ*ГЁГҐ Г*òðèáóòГ* "href"
- lnk = Mid(lnk, InStr(lnk, "imgurl")) 'ГЎ) ïîëó÷Г*ГҐГ¬ ГўГ*óòðè Г*ГҐГЈГ® ГЇГ*Г°Г*ìåòð "imgurl"
- lnk = Mid(Left(lnk, InStr(lnk, "&") - 1), 8) 'Гў) îòñåêГ*ГҐГ¬ ñëîâî "imgurl=" ГЁ âòîðè÷Г*ûå ГЇГ*Г°Г*ìåòðû.
- 'Debug.Print lnk
- animalColl.Add lnk
- Next oAnc
- If animalColl.Count = 0 Then
- MsgBox "ГѓГҐГ*ГЁГ*ëüГ*Г®! ГЉГ*ГЄ ГўГ» óìóäðèëèñü Г±Г*îâГ* ïîëó÷èòü ГЅГІГі îøèáêó? ГђГ*Г±Г±ГЄГ*æèòå ñâîþ èñòîðèþ Aksima Г*Г* ôîðóìå cyberforum.ru"
- Unload Me
- Exit Sub
- End If
- Next i
- Set oIE = Nothing
- 'Г‡Г*Г*îñèì ñïèñîê ññûëîê Гў Г¬Г*Г±Г±ГЁГў - Г± Г¬Г*ññèâîì óäîáГ*ГҐГҐ.
- n = animalColl.Count - 1
- ReDim animals(n) As String
- For i = 0 To n
- animals(i) = animalColl(i + 1)
- Next i
- 'ÏåðåìåøèâГ*ГҐГ¬ ññûëêè ñëó÷Г*Г©Г*ûì îáðГ*çîì.
- Randomize
- For i = 0 To 1
- newi = Int(Rnd() * (n + 1))
- t = animals(i)
- animals(i) = animals(newi)
- animals(newi) = t
- Next i
- For i = n To 1 Step -1
- newi = Int(Rnd() * (i + 1))
- t = animals(i)
- animals(i) = animals(newi)
- animals(newi) = t
- Next i
- 'ÈçîáðГ*æåГ*ГЁГї ГЇГ® äâóì ïåðâûì ññûëêГ*Г¬ Г§Г*ãðóæГ*ГҐГ¬ Г*Г* ГЄГ*îïêè,
- 'ГЁ ГўГ±ГҐ ññûëêè ñîõðГ*Г*ГїГҐГ¬ Гў ñêðûòîå òåêñòîâîå ïîëå äëÿ
- 'Г¤Г*ëüГ*åéøåãî èñïîëüçîâГ*Г*ГЁГї.
- tbAnimals = Join(animals, ",")
- Set oHTTP = CreateObject("MSXML2.XMLHTTP")
- Set oStream = CreateObject("ADODB.Stream")
- oStream.Type = 1
- p = ThisWorkbook.Path & "\"
- For i = 0 To 1
- picName = Mid(animals(i), InStrRev(animals(i), "/") + 1)
- oHTTP.Open "GET", animals(i), False
- oHTTP.Send
- oStream.Open
- oStream.Write oHTTP.responseBody
- oStream.SaveToFile p & picName
- oStream.Close
- Set oCB = Me.Controls("cbAnimal" & i + 1)
- oCB.Picture = LoadPicture(p & picName, oCB.Width, oCB.Height)
- Kill p & picName
- Next i
- Set oStream = Nothing
- Set oHTTP = Nothing
- f = True
- End Sub
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д