简体   繁体   English

尝试使用excel vba从html显示图像

[英]Try to display image from html using excel vba

i am working in excel vba. 我正在使用Excel VBA。 i want to insert an image in html using excel vba. 我想使用excel vba在html中插入图像。 but it doesn't show the image. 但它不显示图像。

PlyrName="Me"
PlyrPicLoc = "C:\EP\Player Image\asdf1234567894.jpg"

HTML = "<!DOCTYPE html>" & _
"<html>" & _
"<head>" & _
"<title>" & PlyrName & "'s Profile" & "</title>" & _
"</head>" & _
"<body>" & _
"<img src=" & PlyrPicLoc & " height='150' width='150'>" & _
"</body>" & _
"</html"> 

Set objIE = CreateObject("InternetExplorer.Application") With objIE
    .Navigate "about:blank"
    Do While .Busy: DoEvents: Loop
    Do While .ReadyState <> 4: DoEvents: Loop
    .Visible = True
    .Document.Write HTML End With
Set objIE = Nothing

UPDATE LAST AUGSUST 22 2013 更新最后一次建议2013年8月22日

guyz it's working if im going to use the original picture that came from the web or i made it from adobe/snip but the problem is if that picture is only copied from original one and save it to EP\\Player Image Folder using this code. 如果我要使用来自网络的原始图片或者我是从adobe / snip制作的,guyz可以正常工作,但问题是,如果仅从原始图片复制该图片并将其保存到使用此代码的EP \\ Player Image Folder中。 it's not displaying. 它没有显示。 maybe there's something wrong wtih my code on copying? 也许我的复制代码有问题吗?

Private Sub cmdinsertpic_Click()
Dim fd As FileDialog
Dim objfl As Variant
Dim msg


Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
    .ButtonName = "Select"
    .AllowMultiSelect = False
    .Filters.Add "Image Files", "*.jpg;*.gif;*.bmp", 1
    .Title = "Choose Player's image"
    .InitialView = msoFileDialogViewDetails
    .Show
        For Each objfl In .SelectedItems
            FilNam = objfl
            Image1.Picture = LoadPicture(objfl)
            'Picturebox1.Image = Image.FromFile(OpenFileDalog.Filename)
        Next objfl
    On Error GoTo 0
End With

    'THIS WILL COPY THE PICTURE TO EP\Player Image Folder
    NameFile = Application.ThisWorkbook.Path & "\Player Image\" & Trim(txtnewplayername.Value & txtnewmc.Value) & ".gif"
    Call SavePicture(Image1.Picture, NameFile)

Set fd = Nothing

End Sub

For example i copied that orignal picture and name it as asdf1234567894.gif and will save to EP\\Player Image Folder 例如,我复制了该原始图片并将其命名为asdf1234567894.gif ,并将其保存到EP \\ Player Image Folder

Private Sub LoadPic_Click()
Dim objIE As SHDocVw.InternetExplorer
PlyrPicLoc = "file:///C:/EP/Player%20Image/asdf1234567894.gif"
Const PlyrNames = "Me"
Dim FSObj As Scripting.FileSystemObject
Dim TStream As Scripting.TextStream

sPATH = "C:\EP\sample.html"
sURL = "C:/EP/sample.html"

shtml = "<body>" & _
"<title>" & PlyrNames & "'s Profile" & "</title>" & _
"<img src=" & Chr(34) & PlyrPicLoc & Chr(34) & " height='150' width='150'>" & _
"<body>" & _
"</body>" & _
"</html>"

Set FSObj = New Scripting.FileSystemObject
Set TStream = FSObj.CreateTextFile(sPATH, True)
TStream.WriteLine (shtml)
TStream.Close


Set objIE = CreateObject("InternetExplorer.Application")

With objIE
    .Navigate sURL
    Do While .Busy: DoEvents: Loop
    Do While .ReadyState <> 4: DoEvents: Loop
    .Visible = True
End With

Set objIE = Nothing
Set FSObj = Nothing
Set TStream = Nothing
End Sub

Hey if you look at the source of generated page you should see the " are missing around your img source. 嘿,如果您查看生成页面的来源,您应该会在img来源周围看到“”字样。

Try changing 尝试改变

"<img src=" & PlyrPicLoc & " height='150' width='150'>"

to

 "<img src=" & Chr(34) & PlyrPicLoc &  Chr(34) & " height='150' width='150'>" 

If that fails can you post your html source from generated page? 如果失败,您可以从生成的页面发布html源代码吗?

TESTED AND WORKING OK WITH PNG AND JPG AND IE9 经过测试,可以使用PNG,JPG和IE9正常工作

PlyrName="Me"
PlyrPicLoc = "PATH TO PICTURE"

HTML = "<!DOCTYPE html>" & _
"<html>" & _
"<head>" & _
"<title>" & PlyrName & "'s Profile" & "</title>" & _
"</head>" & _
"<body>" & _
"<img src=" & PlyrPicLoc & " height='150' width='150'>" & _
"</body>" & _
"</html>" 

Set objIE = CreateObject("InternetExplorer.Application") 
With objIE
    .Navigate "about:blank"
    Do While .Busy: DoEvents: Loop
    Do While .ReadyState <> 4: DoEvents: Loop
    .Visible = True
    .Document.Write HTML 
End With
Set objIE = Nothing

Ok, I have investigated the source code, I have tried modifying it, but nothing I did seemed to work. 好的,我已经研究了源代码,尝试对它进行修改,但是似乎没有做任何事情。 I tried copying it into a text file and saving as html and hey presto it worked. 我尝试将其复制到文本文件中并另存为html,嘿,以前它起作用了。 Unfortunately I don't know why. 不幸的是我不知道为什么。 I have compared the source code for the text file and code generated by excel and they are identical, but for some reason opening a text file works and writing it using .document.write did not. 我已经比较了文本文件的源代码和excel生成的代码,它们是相同的,但是由于某种原因,打开文本文件并使用.document.write进行写入是不可行的。

As a work around I have used a file scripting object to write a text file version of the source code and then got the internet explorer object to navigate to that. 作为一种变通方法,我使用了文件脚本对象编写源代码的文本文件版本,然后使用Internet Explorer对象进行导航。 the code I used is shown below the only things you should need to change are the addresses of the image and the text file. 下面显示的是我使用的代码,您唯一需要更改的就是图像和文本文件的地址。 You should not need to change the text file adress as the file scripting object should overwrite it. 您不需要更改文本文件地址,因为文件脚本对象应该覆盖它。

To make it work you will need to add references to microsoft scripting runtime and microsoft internet controls. 为了使其正常工作,您将需要添加对Microsoft脚本运行时和Microsoft Internet控件的引用。

Sub image()
Dim objIE As SHDocVw.InternetExplorer
PlyrPicLoc = "file:///C:/Documents%20and%20Settings/All%20Users/Documents/My%20Pictures/Sample%20Pictures/Water%20lilies.jpg"
Const PlyrName = "Me"
Dim FSObj As Scripting.FileSystemObject
Dim TStream As Scripting.TextStream

sPATH = "E:\My Documents\StackOverflow\TestC.html"
sURL = "E:/My Documents/StackOverflow/TestC.html"

shtml = "<body>" & _
"<title>" & PlyrName & "'s Profile" & "</title>" & _
"<img src=" & Chr(34) & PlyrPicLoc & Chr(34) & " height='150' width='150'>" & _
"<body>" & _
"</body>" & _
"</html>"

Set FSObj = New Scripting.FileSystemObject
Set TStream = FSObj.CreateTextFile(sPATH, True)
TStream.WriteLine (shtml)
TStream.Close


Set objIE = CreateObject("InternetExplorer.Application")

With objIE
    .Navigate sURL
    Do While .Busy: DoEvents: Loop
    Do While .ReadyState <> 4: DoEvents: Loop
    .Visible = True
End With

Set objIE = Nothing
Set FSObj = Nothing
Set TStream = Nothing 



End Sub

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM