Code chèn ảnh vào comment bằng nút bấm (1 người xem)

[congnguyen88]

Tôi có 1 bảng tính Excel và tôi phải thường xuyên chèn ảnh vào Comment mổi lần như vậy tôi làm thao tác như sau:

click phải vào khung viền của ô comment, chọn format comment, tại thẻ "Color and lines", chọn fill --> Fill effects ....
Như vậy mất quá nhiều thao tác. Tôi muốn ngắn gọn như sau:

Step 1: Chọn vào ô cần chèn ảnh vào Comment ( ô đó đã insert comment trước rồi nhưng chưa có ảnh )
Step 2: Chọn vào nút bấm " Chèn ảnh " thì sẽ xuất hiện 1 cửa số lấy ảnh từ source của máy tính
Step 3 : chọn insert từ cửa sổ là xong

Anh em nào biết giúp đở mình. Xin cảm ơn nhiều nhiều

 

[nghiaphuc]

Tôi có 1 bảng tính Excel và tôi phải thường xuyên chèn ảnh vào Comment mổi lần như vậy tôi làm thao tác như sau:

click phải vào khung viền của ô comment, chọn format comment, tại thẻ "Color and lines", chọn fill --> Fill effects ....
Như vậy mất quá nhiều thao tác. Tôi muốn ngắn gọn như sau:

Step 1: Chọn vào ô cần chèn ảnh vào Comment ( ô đó đã insert comment trước rồi nhưng chưa có ảnh )
Step 2: Chọn vào nút bấm " Chèn ảnh " thì sẽ xuất hiện 1 cửa số lấy ảnh từ source của máy tính
Step 3 : chọn insert từ cửa sổ là xong

Anh em nào biết giúp đở mình. Xin cảm ơn nhiều nhiều

Bạn thử code sau xem sao:
[GPECODE=vb]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[/GPECODE]

 

[congnguyen88]

Bạn thử code sau xem sao:
[GPECODE=vb]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[/GPECODE]

Cảm ơn bạn rất nhiều. mình làm được rồi, hihi bạn học Vba ở đâu zậy. cho minh tài liệu học với

 

[ndu96081631]

Bạn thử code sau xem sao:
[GPECODE=vb]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[/GPECODE]

Thêm cách nữa hen:

Sub FillComment()
  Dim vFile
  If Not ActiveCell.Comment Is Nothing Then
    vFile = Application.GetOpenFilename("All Pictures, *.bmp; *.jpg; *.jpeg;*.png;*.gif")
    If TypeName(vFile) = "String" Then ActiveCell.Comment.Shape.Fill.UserPicture CStr(vFile)
  End If
End Sub

Ẹc... Ẹc....

 

[chuot0106]

Thêm cách nữa hen:

Sub FillComment()
  Dim vFile
  If Not ActiveCell.Comment Is Nothing Then
    vFile = Application.GetOpenFilename("All Pictures, *.bmp; *.jpg; *.jpeg;*.png;*.gif")
    If TypeName(vFile) = "String" Then ActiveCell.Comment.Shape.Fill.UserPicture CStr(vFile)
  End If
End Sub

Ẹc... Ẹc....

Em xin phép chen ngang chút:
Em xin hỏi kiến thức mà thầy và anh NghiaPhuc dùng viết code này có liên quan tới ADO không ạ? Nếu không phải thì liên quan tới kiến thức nào ạ???

 

[ndu96081631]

Em xin phép chen ngang chút:
Em xin hỏi kiến thức mà thầy và anh NghiaPhuc dùng viết code này có liên quan tới ADO không ạ?

Ủa! Code dùng để hiện mấy Dialog thì liên quan gì đến ADO đâu chứ?

Nếu không phải thì liên quan tới kiến thức nào ạ???

Chắc là liên quan đến... Excel! Ẹc... Ẹc...

 

[mandala]

Em có một câu hỏi anh giải thích hộ em với.

B1:
Em có ghi lại macro tạo 1 ô coments với kích thước chiều cao và rộng ("macro2")
' chieu dai
Selection.ShapeRange.ScaleHeight 2.76, msoFalse, msoScaleFromTopLeft
' chieu rong
Selection.ShapeRange.ScaleWidth 1.19, msoFalse, msoScaleFromTopLeft

B2:
Sau đó em xóa coments tại ô AP29 đi và chạy lại sub Maccro2 thì kích thước của ô không như cũ mà nó thu về mặc định và báo lỗi.

Em muốn hỏi có cách nào giữ nguyên ô coments như thiết lập ban đầu được không?
Có cách chèn ảnh vào ô coments mà ảnh vẫn giữ nguyên được kích thước ban đầu của ảnh không?
thank !

Sub Macro2()
' tao coments
Range("AP29").Select
Range("AP29").AddComment
Range("AP29").Comment.Visible = False
Range("AP29").Comment.Text Text:="User:" & Chr(10) & ""
' chieu dai
Selection.ShapeRange.ScaleHeight 2.76, msoFalse, msoScaleFromTopLeft
' chieu rong
Selection.ShapeRange.ScaleWidth 1.19, msoFalse, msoScaleFromTopLeft
End Sub

Sub Macro3()
' xoa coments
Range("AP29").Select
Selection.ClearComments
End Sub