Chèn ảnh vào những vị khác nhau trên sheet

[dokhactrung]

Em chào các pro chả là công việc của em là chụp rất nhiều ảnh và chèn vào excel ở những ô khác nhau trong nhiều sheets.yêu cầu là ảnh tên A,B,C thì gán vào ô nào đó trên form mà mẫu nó đã quy định (ví dụ anh tên "hoa" thì gán vào ô A2(có tên lá hoa), ảnh tên "Lan" thì gắn vào ô c6(Tên ô là Lan), nó cũng không theo quy luật), vậy trong sheet 1 em muốn gắn vi dụ 5 ảnh bằng 1 lệnh được không,(nếu là từng ảnh thì em đã làm được rồi ạ,vì em chụp rất nhiều ảnh mà copy từng lênh như thế thì chương trình dài quá), và nếu sử dụng cho tất cả các sheets thì có làm được không ạ.Vì em cũng mới học nên kiến thức còn kém các pro nào trợ giúp cho em giải pháp phù hợp không ạ.Em cảm ơn nhiều ạ.

 

[nguyenthuy13388]

Em chào các pro chả là công việc của em là chụp rất nhiều ảnh và chèn vào excel ở những ô khác nhau trong nhiều sheets.yêu cầu là ảnh tên A,B,C thì gán vào ô nào đó trên form mà mẫu nó đã quy định (ví dụ anh tên "hoa" thì gán vào ô A2(có tên lá hoa), ảnh tên "Lan" thì gắn vào ô c6(Tên ô là Lan), nó cũng không theo quy luật), vậy trong sheet 1 em muốn gắn vi dụ 5 ảnh bằng 1 lệnh được không,(nếu là từng ảnh thì em đã làm được rồi ạ,vì em chụp rất nhiều ảnh mà copy từng lênh như thế thì chương trình dài quá), và nếu sử dụng cho tất cả các sheets thì có làm được không ạ.Vì em cũng mới học nên kiến thức còn kém các pro nào trợ giúp cho em giải pháp phù hợp không ạ.Em cảm ơn nhiều ạ.

Đặt code dưới đây vào Workbook

Private PWidth As Integer
Private PHeight As Integer
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
PWidth = Target.Width
PHeight = Target.Height
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim PFName As String
PFName = "D:\CUA GO THACH THAT\CAU THANG GO\" & Target.Value & ".jpg" 
On Error Resume Next
Sh.Shapes(Target.Value).Delete
On Error GoTo 0
If Dir(PFName) = "" Then
    MsgBox "Khong tim thay anh: " & Target.Value
Else
    With ActiveSheet.Shapes.AddPicture(PFName, True, True, Target.Left, Target.Top, PWidth, PHeight)
        .Name = Target.Value
        .Apply
    End With
End If
End Sub

 

[dokhactrung]

Đặt code dưới đây vào Workbook

Private PWidth As Integer
Private PHeight As Integer
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
PWidth = Target.Width
PHeight = Target.Height
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim PFName As String
PFName = "D:\CUA GO THACH THAT\CAU THANG GO\" & Target.Value & ".jpg"
On Error Resume Next
Sh.Shapes(Target.Value).Delete
On Error GoTo 0
If Dir(PFName) = "" Then
    MsgBox "Khong tim thay anh: " & Target.Value
Else
    With ActiveSheet.Shapes.AddPicture(PFName, True, True, Target.Left, Target.Top, PWidth, PHeight)
        .Name = Target.Value
        .Apply
    End With
End If
End Sub

Đặt code dưới đây vào Workbook

Private PWidth As Integer
Private PHeight As Integer
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
PWidth = Target.Width
PHeight = Target.Height
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim PFName As String
PFName = "D:\CUA GO THACH THAT\CAU THANG GO\" & Target.Value & ".jpg"
On Error Resume Next
Sh.Shapes(Target.Value).Delete
On Error GoTo 0
If Dir(PFName) = "" Then
    MsgBox "Khong tim thay anh: " & Target.Value
Else
    With ActiveSheet.Shapes.AddPicture(PFName, True, True, Target.Left, Target.Top, PWidth, PHeight)
        .Name = Target.Value
        .Apply
    End With
End If
End Sub

Cảm ơn bác nhiều.Đúng là nhờ mcro tự động mà thay thế được bao nhiêu thao tác.

 

[babyheomoi]

Cảm ơn bác nhiều.Đúng là nhờ mcro tự động mà thay thế được bao nhiêu thao tác.

Mở file và nhìn yêu cầu em vẫn chưa hiểu anh muốn làm thế nào?
Bác up file đã hoàn chỉnh cho em tham khảo với!

 

[nguyenthuy13388]

Mở file và nhìn yêu cầu em vẫn chưa hiểu anh muốn làm thế nào?
Bác up file đã hoàn chỉnh cho em tham khảo với!

bạn copy code dán vào phần khung đỏ nhé