Chèn ảnh vào 1 Ô Excel bằng nút bấm (3 người xem)

[congnguyen88]

Tôi đã dùng đoạn code này Hoàng Nghĩa Phúc để chèn ảnh vào Comment bằng nút bấm, Giờ có cách nào sửa lại để chèn ảnh vào 1 ô Excel không ?

Sub FillComment()
On Error Resume Next
With Application.FileDialog(msoFileDialogFilePicker)
.InitialFileName = ThisWorkbook.Path
.Title = "Chon file anh..."
.Filters.Add "File anh", "*.jpg;*.jpeg;*.png;*.gif", 2
.AllowMultiSelect = False: .Show
If .SelectedItems.Count = 0 Then Exit Sub
ActiveCell.Comment.Shape.Fill.UserPicture .SelectedItems(1)
End With
End Sub


Các bước thực hiện tôi mong muốn như sau :
Step 1: Chọn vào ô Cần chèn ảnh ( tất nhiên ô này có chỉnh độ rộng trước )
Step 2: Chọn vào nút bấm CHÈN ẢNH
Step 3: Hiện ra 1 cửa sổ để lấy ảnh từ source của máy tính
Step 4: Chọn ảnh, Chọn Insert từ cửa sổ là xong
ảnh sẽ nằm lọt vừa ghít trong ô luôn

 

[nghiaphuc]

Cũng từ topic đó, xin mượn code của anh ndu96081631 để "xào nấu" lại:
[GPECODE=vb]Sub InsertPicture()
Dim vFile
vFile = Application.GetOpenFilename("All Pictures, *.bmp;*.jpg;*.jpeg;*.png;*.gif")
If TypeName(vFile) = "String" Then
With ActiveCell
ActiveSheet.Shapes.AddPicture(CStr(vFile), msoFalse, msoTrue, .Left, .Top, .Width, .Height).Placement = xlMoveAndSize
End With
End If
End Sub[/GPECODE]
Với code trên, sau khi chèn ảnh thì hình ảnh sẽ tự động điều chỉnh kích thước khi bạn thay đổi kích thước của ô.

 

[ndu96081631]

Tôi đã dùng đoạn code này Hoàng Nghĩa Phúc để chèn ảnh vào Comment bằng nút bấm, Giờ có cách nào sửa lại để chèn ảnh vào 1 ô Excel không ?

Sub FillComment()
On Error Resume Next
With Application.FileDialog(msoFileDialogFilePicker)
.InitialFileName = ThisWorkbook.Path
.Title = "Chon file anh..."
.Filters.Add "File anh", "*.jpg;*.jpeg;*.png;*.gif", 2
.AllowMultiSelect = False: .Show
If .SelectedItems.Count = 0 Then Exit Sub
ActiveCell.Comment.Shape.Fill.UserPicture .SelectedItems(1)
End With
End Sub


Các bước thực hiện tôi mong muốn như sau :
Step 1: Chọn vào ô Cần chèn ảnh ( tất nhiên ô này có chỉnh độ rộng trước )
Step 2: Chọn vào nút bấm CHÈN ẢNH
Step 3: Hiện ra 1 cửa sổ để lấy ảnh từ source của máy tính
Step 4: Chọn ảnh, Chọn Insert từ cửa sổ là xong
ảnh sẽ nằm lọt vừa ghít trong ô luôn

Vầy thử xem:

Sub InsertPic()
  Dim vFile, pic As Picture
  vFile = Application.GetOpenFilename("All Pictures, *.bmp; *.jpg; *.jpeg;*.png;*.gif")
  If TypeName(vFile) = "String" Then
    On Error Resume Next
    With ActiveCell
      .Parent.Shapes(.Address).Delete
      On Error GoTo 0
      Set pic = .Parent.Pictures.Insert(CStr(vFile))
      pic.ShapeRange.LockAspectRatio = False
      pic.Left = .Left: pic.Top = .Top
      pic.Width = .Width: pic.Height = .Height
      pic.Placement = 1
      pic.Name = .Address
    End With
  End If
End Sub