How can I display an image in a MsgBox?
The answer is: This is not possible. MsgBox can only display strings. (Documentation)
An alternative is to display your image in a small Internet Explorer window. Here's an example:
Set objExplorer = CreateObject("InternetExplorer.Application")
With objExplorer
.Navigate "about:blank"
.ToolBar = 0
.StatusBar = 0
.Left = 100
.Top = 100
.Width = 200
.Height = 200
.Visible = 1
.Document.Title = "Important image!"
.Document.Body.InnerHTML = _
"<img src='http://sstatic.net/stackoverflow/img/venn-diagram.png' height=100 width=100>"
End With
This should display the Venn diagram found in Stack Overflow's about section.
What you want is called a HyperText Application, or HTA. You use HTML to create the form.
Related
I am trying to write a piece of code so when the user clicks "yes" on my message box my yes.gif opens in IE, but if the user clicks "no" I want my no.gif to open in IE. I get a synax error on line 5 (Else statement).
My code:
Result = MsgBox("Text", 20, "Title")
If Result = vbYes Then Set objExplorer = CreateObject("InternetExplorer.Application")
Else Result = vbNo Then Set objExplorer1 = CreateObject("InternetExplorer.Application")
With objExplorer
.Navigate "about:blank"
.Visible = 1
.Document.Title = "Right Decision"
.Toolbar = False
.Statusbar = False
.Top = 500
.Left = 500
.Height = 400
.Width = 600
.Document.Body.InnerHTML = "<img src='C:\User\yes.gif'>"
End With
With objExplorer1
.Navigate "about:blank"
.Visible = 1
.Document.Title = "Wrong Decision"
.Toolbar = False
.Statusbar = False
.Top = 500
.Left = 500
.Height = 400
.Width = 600
.Document.Body.InnerHTML = "<img src='C:\User\no.gif'>"
End With
There are multiple issues with your code:
The only possible values from the MsgBox are vbYes and vbNo because you launched it with the vbYesNo flag. Since the result is binary there is no need for multiple comparisons (which don't work like that in VBScript anyway).
Your If statement uses the single-line If..Then form, meaning that the subsequent Else is invalid. And even if it weren't invalid the syntax would still be incorrect.
Starting different IE instances is pointless when a string and an image name are the only differences.
Your code tries to configure both instances, but one of them will be invalid regardless of the user's choice.
Use an If..Then..Else to define the settings that actually differ, then create the IE instance after the conditional and configure it accordingly.
Result = MsgBox("Text", vbYesNo + vbCritical, "Title")
If Result = vbyes Then
title = "Right Decision"
picture = "C:\User\yes.gif"
Else
title = "Wrong Decision"
picture = "C:\User\no.gif"
End If
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Navigate "about:blank"
.Visible = True
.Document.Title = title
.Toolbar = False
.Statusbar = False
.Top = 500
.Left = 500
.Height = 400
.Width = 600
.Document.Body.InnerHtml = "<img src='" & picture & "'>"
End With
See Error Message here
I have a script that had been working fine since years. Last week, we changed the user account and suddenly it stopped working and started returning with VBScript error 800A01B6 document.parentwindow.screen.availwidth. If we login with the previous account and execute the script, it runs perfect as ever. However, it does not run with the new account. The new user account is also in the same Administrators group as the old account. I can't figure out the difference between the two executions.
Please help.
Here's a sample of the code:
Dim oIEPW, sPWHTML, ctr
Dim objWMIService, colItems, objItem, ScreenWidth, ScreenHeight, Scr
'Get HTML and place it in a variable
Call WriteHTML(sPWHTML)
'Create Internet Explorer object
'Set oIEPW = WScript.CreateObject("InternetExplorer.Application", "IE_")
Set oIEPW = WScript.CreateObject("InternetExplorer.Application", "IE_")
'Set window properties
With oIEPW
.Navigate "about:blank" 'Use blank page as base
Do While .ReadyState <> 4 'Wait for IE process to start
WScript.Sleep 50
Loop
.Document.Open 'Create document that will be in IE window
.Document.Write (sPWHTML) 'Paste in HTML
.Document.Close 'Complete the page creation
.Resizable = 0
.ToolBar = 0 'Disable IE's tool bars
.StatusBar = 0 'Disable IE's status bar
.Width = 294 'Set window width in pixels
.Height = 155 'Set window height in pixels
ScreenWidth = .Document.ParentWindow.Screen.AvailWidth 'Find screen width in pixels
.Left = (ScreenWidth / 2) - (.Width / 2) 'Distance in pixels of window left edge to left side of screen
ScreenHeight = .Document.ParentWindow.Screen.AvailHeight 'Find screen height in pixels
.Top = (ScreenHeight /2) - (.Height / 2) 'Distance in pixels of window top edge to top of screen
'WshShell.Popup "Width: " & ScreenWidth & VbCrLf & "Height: " & ScreenHeight,,"Screen Resolution",4096
Do While .ReadyState <> 4 'Wait for all properties to be set
WScript.Sleep 50
Loop
.Visible = 1 'Make IE window visible
End With
'Bring IE window to the top
WshShell.AppActivate "Internet Explorer"
I'm not a programmer and i need help.
How to combine this two scripts into one?
Then i will convert this to EXE and give as present on Tank Style pendrive :).
pass=inputbox("Password?")
if pass="fish" then msgbox("Correct Password!") else msgbox("Incorrect Password!")
AND
Set objExplorer = CreateObject("InternetExplorer.Application")
With objExplorer "
.Navigate "about:blank"
.ToolBar = 0
.StatusBar = 0
.Left = 200
.Top = 200
.Width = 650
.Height = 440
.Visible = 1
.Document.Title = "Kocham cie Maciek!"
.Document.Body.InnerHTML = _
"<center>Kocham cie Maciek <3<br><br><img src='http://www.crystalclearsports.net/file/2016/07/use_love_quotes_for_him_and_inspire_romantic_vitality.jpg' height=336 width=600></center>"
"
End With
When someone type good password it show Picture1, if bad Picture2.
Try this!
Dim MyPassword, objExplorer
MyPassword = InputBox("Enter the Password and Press 'OK' ", "Password")
MyPassword = Trim(MyPassword)
If MyPassword = "" Then
Msgbox "No Password is entered"
Else
Set objExplorer = CreateObject("InternetExplorer.Application")
With objExplorer
.Navigate "about:blank"
.ToolBar = 0
.StatusBar = 0
.Left = 200
.Top = 200
.Width = 650
.Height = 440
.Visible = 1
.Document.Title = "Kocham cie Maciek!"
End With
If StrComp(MyPassword, "FISH", 1) = 0 Then
' Correct Password
Msgbox "The Password is Correct"
objExplorer.Document.Body.InnerHTML = "<center>Kocham cie Maciek <3<br><br><img src='http://www.crystalclearsports.net/file/2016/07/use_love_quotes_for_him_and_inspire_romantic_vitality.jpg' height=336 width=600></center>'"
Else
Msgbox "Incorrect Password"
objExplorer.Document.Body.InnerHTML = "<center>Kocham cie Maciek <3<br><br><img src='XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX' height=336 width=600></center>'"
End If
End if
you missed the second image, update the XXXX with the location of second image you would want to show!!
This might to be too easy to ask but i am a beginner.
I want to be able to copy ranges from a worksheet and paste it to another worksheet in adjusted size which i should pick and paste it to selected range area in the otherworksheet.
When i do this by using a macro, i can paste it and adjust its size manually.When i try to use this recoreded macro again, it does not paste it to the range that i have selected and its size is not like its original nor like my adjusted size.
How can i specify the size and the ranges the paste?
If you paste image, you can use .width, .height, .top, .left to position it and to set it width and height. Also if you wana to fit in certain range, you can specify it by .width, .height, .top, .left atributes of that range, or even cells. Need further example? It seems too clear to me :(
edit: Try something like this
Sub copyPic()
Dim targetSheet As Worksheet
Set targetSheet = Sheets("Sheet1")
With targetSheet
.Range(.Cells(1, 1), .Cells(3, 3)).CopyPicture
.Paste
Selection.Name = "pastedPic"
With .Shapes("pastedPic")
.Top = targetSheet.Cells(5, 5).Top
.Left = targetSheet.Cells(5, 5).Left
.Width = 50
.Height = 50
End With
End With
End Sub
You can use something like
.range("A1:B10")
instead of my reference, but try to understand it, its much easier to read. It tells you that you wana range which have two corners cells which are specified by row and column number (in this order). Or selection can even be .range(.cells(1,"A"),.cells(3,"C")) but numbers are number... and eventualy if you need to increment range columns or numbers... its much better aproach
So for your need it will be
Sub copyPic()
Dim targetSheet As Worksheet
Set targetSheet = Sheets("Sheet1")
With targetSheet
.Range("A1:B10") .CopyPicture
.Paste
Selection.Name = "pastedPic"
With .Shapes("pastedPic")
.Top = targetSheet.Cells(5, 5).Top
.Left = targetSheet.Cells(5, 5).Left
.Width = 50
.Height = 50
End With
End With
End Sub
If you wana to paste it to another workbook, try something like this
Sub copyPic()
Dim targetSheet As Worksheet
Set targetSheet = Sheets("Sheet1")
Dim targetWB as excel.workbook
set targetWB = workbooks.open("pathToYourWorkbook")
With targetSheet
.Range("A1:B10") .CopyPicture
targetWb.sheets("sheetName").Paste
Selection.Name = "pastedPic"
With .Shapes("pastedPic")
.Top = targetSheet.Cells(5, 5).Top
.Left = targetSheet.Cells(5, 5).Left
.Width = 50
.Height = 50
End With
End With
End Sub
I have below macro.
Could you please modify it in such ways that it will show slide number on the top and also extract notes page.
I tried all ways but couldn't get answer-:
Sub WriteToWord()
Dim aSlide As Slide, MyDoc As New Word.Document, MyRange As Word.Range
Dim aTable As Table, aShape As Shape, TablesCount As Integer, ShapesCount As Integer
Dim i As Word.Paragraph
On Error Resume Next
With MyDoc
.Application.Visible = False
.Application.ScreenUpdating = False
For Each aSlide In ActivePresentation.Slides
For Each aShape In aSlide.Shapes
Set MyRange = .Range(.Content.End - 1, .Content.End - 1)
Select Case aShape.Type
Case msoAutoShape, msoPlaceholder, msoTextBox
If aShape.TextFrame.HasText Then
aShape.TextFrame.TextRange.Copy
MyRange.Paste
With MyRange
.ParagraphFormat.Alignment = wdAlignParagraphLeft
For Each i In MyRange.Paragraphs
If i.Range.Font.Size >= 16 Then
i.Range.Font.Size = 14
Else
i.Range.Font.Size = 12
End If
Next
End With
End If
Case msoPicture
aShape.Copy
MyRange.PasteSpecial DataType:=wdPasteMetafilePicture
ShapesCount = .Shapes.Count
With .Shapes(ShapesCount)
.LockAspectRatio = msoFalse
.Width = Word.CentimetersToPoints(14)
.Height = Word.CentimetersToPoints(6)
.Left = wdShapeCenter
.ConvertToInlineShape
End With
.Content.InsertAfter Chr(13)
Case msoEmbeddedOLEObject, msoLinkedOLEObject, msoLinkedPicture, msoOLEControlObject
aShape.Copy
MyRange.PasteSpecial DataType:=wdPasteOLEObject
ShapesCount = .Shapes.Count
With .Shapes(ShapesCount)
.LockAspectRatio = msoFalse
.Width = Word.CentimetersToPoints(14)
.Height = Word.CentimetersToPoints(6)
.Left = wdShapeCenter
.ConvertToInlineShape
End With
.Content.InsertAfter Chr(13)
Case msoTable
aShape.Copy
MyRange.Paste
TablesCount = .Tables.Count
With .Tables(TablesCount)
.PreferredWidthType = wdPreferredWidthPercent
.PreferredWidth = 100
.Range.Font.Size = 11
End With
.Content.InsertAfter Chr(13)
End Select
Next
If aSlide.SlideIndex < ActivePresentation.Slides.Count Then .Content.InsertAfter Chr(12)
.UndoClear ' Clear used memory
Next
' Change white font to black color
With .Content.Find
.ClearFormatting
.Format = True
.Font.Color = wdColorWhite
.Replacement.Font.Color = wdColorAutomatic
.Execute Replace:=wdReplaceAll
End With
MsgBox "PPT Converted to WORD completed, Please check and save document", vbInformation + vbOKOnly, "ExcelHome/ShouRou"
.Application.Visible = True
.Application.ScreenUpdating = True
End With
End Sub
Sub Auto_Open() ' Add PPTtoWord to Tool Bar when Powerpoint start
Dim MyControl As CommandBarControl
On Error Resume Next
Application.CommandBars("Standard").Controls("PPTtoWord").Delete
Set MyControl = Application.CommandBars("Standard").Controls.Add(Before:=1)
With MyControl
.Caption = "PPTtoWord"
.FaceId = 567 ' Word Icon
.Enabled = True
.Visible = True
.Width = 100
.OnAction = "WriteToWord"
.Style = msoButtonIconAndCaption
End With
End Sub
Sub Auto_Close() ' Delete PPTtoWord from Tool Bar when Powerpoint close
On Error Resume Next
Application.CommandBars("Standard").Controls("PPTtoWord").Delete
End Sub
You are running this from Word and automating PowerPoint using early binding, you need to fully qualify any PowerPoint reference.
Have you added a reference to PowerPoint library.
Change to aShape As PowerPoint.Shape
Grab the reference to the running instance of PowerPoint. PowerPoint is single instance multi-use so you can use this.
Dim PPT as PowerPoint.Application
Set PPT = CreateObject("PowerPoint.Application")
Fully qualify all references to ActivePresentation with PPT.ActivePresentation
Your macro should run then and generate something so that you can continue debugging.