VBA code Chèn ảnh vào comment

cuong86

Yêu THVBA
JavaScript:
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
 
Sửa lần cuối:
Top