Created
May 11, 2018 13:56
-
-
Save TGDUY/80ef3934381c4a91051cde21ad1e78ce to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Sub AddImage() | |
Dim myFile As FileDialog, ImgFile, myImg As Variant, ZoomF As String | |
On Error Resume Next | |
Set myFile = Application.FileDialog(msoFileDialogOpen) | |
With myFile | |
.Title = "Choose File" | |
.AllowMultiSelect = False | |
.Filters.Add Description:="Images", Extensions:="*.jpg,*.Jpg,*.gif,*.png,*.tif,*.bmp", Position:=1 | |
If .Show <> -1 Then | |
MsgBox "No image selected", vbCritical | |
Exit Sub | |
End If | |
End With | |
ImgFile = myFile.SelectedItems(1) | |
If ImgFile = False Then Exit Sub | |
Application.ScreenUpdating = False | |
ZoomF = InputBox(Prompt:="Your selected file path:" & _ | |
vbNewLine & ImgFile & _ | |
vbNewLine & "" & _ | |
vbNewLine & "Input zoom % factor to apply to picture?" & _ | |
vbNewLine & "(Original picture size equals 100) ." & _ | |
vbNewLine & "Input a number greater than zero!", Title:="Picture Scaling Percentage Factor", Default:=100) | |
If Not IsNumeric(ZoomF) Or ZoomF = 0 Or ZoomF = "" Then | |
MsgBox "You must enter a valid numeric value. Entered value must be a number greater than zero." & _ | |
vbNewLine & "Macro will terminate.", vbCritical | |
Exit Sub | |
End If | |
With ActiveCell | |
.ClearComments | |
.AddComment | |
.Interior.ColorIndex = 19 | |
End With | |
Set myImg = LoadPicture(ImgFile) | |
With ActiveCell.Comment | |
.Shape.Fill.UserPicture ImgFile | |
.Shape.Width = myImg.Width * ZoomF / 2645.9 | |
.Shape.Height = myImg.Height * ZoomF / 2645.9 | |
End With | |
Application.ScreenUpdating = True | |
Set myFile = Nothing: Set myImg = Nothing | |
End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment