Macro chèn hình ảnh ...

[xitrum_007]

Ai giải thích giúp em chỗ code này với. Em đưa vào file của mình thì code nó không chạy cho dù đã chỉnh sửa một số chỗ in đỏ cho phù hợp với file của mình, sao nó vẫn không chạy giống file đính kèm...

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$AP$3" Then
Dim anh As Shape
With Sheet3
For Each anh In .Shapes
If anh.Name Like "Rectangle*" Then anh.Delete
Next
Application.ScreenUpdating = False
.Activate
Sheet1.Shapes("Rectangle " & .[AP3].Value).Copy
.[c3].Select
ActiveSheet.Paste
For Each anh In .Shapes
If anh.Name Like "Rectangle*" Then
anh.Top = .[C3:I10].Top
anh.Left = .[C3:I10].Left
anh.Height = .[C3:I10].Height
anh.Width = .[C3:I10].Width
End If
Next
Application.ScreenUpdating = True
Application.CutCopyMode = False
.[AP3].Select
End With
End If
End Sub

 

[tintam7251]

Bạn cần đưa file bị lỗi lên mới biết lỗi chỗ nào chứ.

 

[xitrum_007]

Bạn cần đưa file bị lỗi lên mới biết lỗi chỗ nào chứ.

Khi mình đưa code này vào file, chạy file thì xuất hiện lỗi, nó xóa sạch ảnh của mình đi
Code này nè bạn, cảm ơn nhiều nha

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$W$9" Then
Dim anh As Shape
With Sheet3
For Each anh In .Shapes
If anh.Name Like "Rectangle*" Then anh.Delete
Next
Application.ScreenUpdating = False
.Activate
Sheet1.Shapes("Rectangle " & .[W9].Value).Copy
.[U5].Select
ActiveSheet.Paste
For Each anh In .Shapes
If anh.Name Like "Rectangle*" Then
anh.Top = .[U5:X8].Top
anh.Left = .[U5:X8].Left
anh.Height = .[U5:X8].Height
anh.Width = .[U5:X8].Width
End If
Next
Application.ScreenUpdating = True
Application.CutCopyMode = False
.[W9].Select
End With
End If
End Sub

 

[xitrum_007]

nhìn thế này sao biết đc lỗi chỗ nào? bạn phải chỉ ra chứ

Mình có upload file QLNV đó bạn, mình đưa code vào sheet LLNV, khi chạy code thì nó xóa hết ảnh trong sheet của mình

 

[ndu96081631]

Mình có upload file QLNV đó bạn, mình đưa code vào sheet LLNV, khi chạy code thì nó xóa hết ảnh trong sheet của mình

Tôi thấy file của bạn bố trí như vậy là không hay đâu! Sao không cho hình vào 1 thư mục riêng? Như vậy file sẽ nhẹ hơn rất nhiều
Giờ tôi làm cho bạn theo hướng trên nha. Code chỉ ngắn thế này thôi:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim sArray, fld As String
  On Error Resume Next
  fld = ThisWorkbook.Path & "\Pic\"
  sArray = Sheets("Data").Range("DS").Value
  If Target.Address = "$AP$3" Then
    With Sheets("HSo").Image1
      .Picture = Nothing
      .Picture = LoadPicture(fld & sArray(Target.Value, 5) & ".jpg")
      .PictureSizeMode = 1
    End With
  End If
End Sub

- Thư mục hình sẽ nằm cùng thư mục với file Excel và tên là Pic
- Tên hình trong thư mục Pic sẽ đặt theo số CMND (để tránh bị trùng)
- Dùng Image control để load hình vào hồ sơ
Xem file

 

[xitrum_007]

- Thư mục hình sẽ nằm cùng thư mục với file Excel và tên là Pic
- Tên hình trong thư mục Pic sẽ đặt theo số CMND (để tránh bị trùng)
- Dùng Image control để load hình vào hồ sơ
Xem file

Anh ơi giúp em chỗ này với, ví dụ em insert thêm một cột là MSNV sau số TT ấy như file đính kèm, thay đổi ở Name Manager nữa như thế này. Thì nó không hiện ảnh nữa. Hiz

=OFFSET(Data!$B$2:$I$2,,,COUNTA(Data!$B$2:$B$1000),)

Mong anh giải thích giùm em!!

 

[dhn46]

Bạn phải sửa code vba nữa mới chạy được
.Picture = LoadPicture(fld & sArray(Target.Value, 5) & ".jpg") ==> sửa số 5 thành số 6
Đây là phần tử thuộc dòng target.value cột 6 của mảng sarray. do đó khi bạn thêm cột thì phải chú ý giá trị này

 

[xitrum_007]

Bạn phải sửa code vba nữa mới chạy được
.Picture = LoadPicture(fld & sArray(Target.Value, 5) & ".jpg") ==> sửa số 5 thành số 6
Đây là phần tử thuộc dòng target.value cột 6 của mảng sarray. do đó khi bạn thêm cột thì phải chú ý giá trị này

Vẫn một màu xám xịt bạn ơi ...

 

[dhn46]

Bạn đã giải nén ra chưa? không giải nén hết ra thì có mà khóc...

 

[ndu96081631]

Anh ơi giúp em chỗ này với, ví dụ em insert thêm một cột là MSNV sau số TT ấy như file đính kèm, thay đổi ở Name Manager nữa như thế này. Thì nó không hiện ảnh nữa. Hiz

Mong anh giải thích giùm em!!

Nếu Insert thêm cột thì chẳng nói làm gì, đàng này bạn thay luôn Validation list nên code phải viết khác hoàn toàn
Có 1 cách giúp ta đở sửa code nhiều, đó là sửa tên các file ảnh theo mã, sau đó chỉnh lại code thế này:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim fld As String
  On Error Resume Next
  fld = ThisWorkbook.Path & "\Pic\"
  If Target.Address = "$AP$3" Then
    With Sheets("HSo").Image1
      .Picture = Nothing
      .Picture = LoadPicture(fld & Target.Value & ".jpg")
      .PictureSizeMode = 1
    End With
  End If
End Sub

Tóm lại tôi có lời khuyên cho bạn và tất cả các thành viên khác: Nếu đưa dữ liệu lên diễn đàn thì nên đưa giống với dữ liệu thật để tránh phải sửa đi sửa lại nhiều lần
Ngay từ đầu bạn đưa lên thế này thì.. ngon rồi

 

[xitrum_007]

Tóm lại tôi có lời khuyên cho bạn và tất cả các thành viên khác: Nếu đưa dữ liệu lên diễn đàn thì nên đưa giống với dữ liệu thật để tránh phải sửa đi sửa lại nhiều lần
Ngay từ đầu bạn đưa lên thế này thì.. ngon rồi

Cảm ơn anh, em muốn hiểu code nó hoạt động thế nào thôi, chứ file của em nhiều dòng nhiều cột hơn file VD của em rất nhiều, file quản lý nhân sự nên rất nhiều thông tin, em đã làm dc hết rồi, chỉ còn mỗi cái code chèn ảnh là không hiểu thôi.
Một lần nữa cảm ơn anh

 

[xitrum_007]

Anh cho em hỏi thêm, mình tạo cái ô chứa ảnh như thế bằng cách nào nhỉ?

 

[ndu96081631]

Anh cho em hỏi thêm, mình tạo cái ô chứa ảnh như thế bằng cách nào nhỉ?

Control ấy nằm trong thanh Control ToolBox ấy
Xem video clip

[video=youtube;R0uSE7t8QJQ]http://www.youtube.com/watch?v=R0uSE7t8QJQ[/video]


-------------------
Còn bạn hỏi:

Cảm ơn anh, em muốn hiểu code nó hoạt động thế nào thôi, chứ file của em nhiều dòng nhiều cột hơn file VD của em rất nhiều, file quản lý nhân sự nên rất nhiều thông tin, em đã làm dc hết rồi, chỉ còn mỗi cái code chèn ảnh là không hiểu thôi.
Một lần nữa cảm ơn anh

Toàn bộ code chỉ cần chứ ý chổ này:

With Sheets("HSo").Image1
  .Picture = Nothing  '<---- Xóa hình trong Image
  .Picture = LoadPicture(fld & Target.Value & ".jpg")  '<--- Load hình vào Image theo đường dẫn
End With

Trong đó:
- fld là thư mục chứa hình (đã được định nghĩa trước đó)
- Target.Value là Mã
- Đoạn fld & Target.Value & ".jpg" sẽ là đường dẫn đầy đủ đến file hình

 

[xitrum_007]

Em cảm ơn anh nhiều nhiều nhiều lắm ạ ...