Lấy tên nội dung của file ảnh vào excel và tự động mở file ảnh khi chọn nội dung đó (13 người xem)

[vc_đi chơi]

Sao bạn không click thử?
Yêu cầu là file Excel và các file ảnh phải nằm cùng thư mục

Có thầy ạ! em clik vào đó nhưng không thấy tác đông gì ạ?
Thầy xem giúp em ạ!

 

[ndu96081631]

Thật tuyệt vời quá anh ơi, cảm ơn anh nhiều. Nhưng tìm được tên có cách nào ảnh đó hiện lên luôn không anh nhỉ?

Chưa hiểu ý bạn là HIỆN như thế nào?

Bài đã được tự động gộp: 2/12/19

Có thầy ạ! em clik vào đó nhưng không thấy tác đông gì ạ?
Thầy xem giúp em ạ!

Bạn phải bấm nút "Get Images" trước thì click mới có tác dụng chứ

 

[Kieutri]

Chưa hiểu ý bạn là HIỆN như thế nào?

Bài đã được tự động gộp: 2/12/19

Bạn phải bấm nút "Get Images" trước thì click mới có tác dụng chứ

Em bấm rồi ạ, hiện nội dung tên của file ảnh, nhưng không hiện lên được "Hình ảnh" ở cột ghi chú ạ. Anh giúp em với anh.

 

[vc_đi chơi]

Chưa hiểu ý bạn là HIỆN như thế nào?

Bài đã được tự động gộp: 2/12/19

Bạn phải bấm nút "Get Images" trước thì click mới có tác dụng chứ

Em bấm nút "Get Images" thì sẽ lấy được tên các file anhsang excel nhưng khi click vào ô nội dung tương ứng trong các ô trong excel thì không có tác động gì, nó giống như những ô excel thông thường không có chứa liên kết thầy ạ!

 

[ndu96081631]

Em bấm nút "Get Images" thì sẽ lấy được tên các file anhsang excel nhưng khi click vào ô nội dung tương ứng trong các ô trong excel thì không có tác động gì, nó giống như những ô excel thông thường không có chứa liên kết thầy ạ!

Người ta hướng dẫn là CLICK trong khi bạn lại DOUBLE CLICK, sao mà có tác dụng được?

 

[ndu96081631]

Em bấm rồi ạ, hiện nội dung tên của file ảnh, nhưng không hiện lên được "Hình ảnh" ở cột ghi chú ạ. Anh giúp em với anh.

Bài toán của bạn khác với yêu cầu của chủ đề này
Theo ý bạn thì code phải sửa lại hơi nhiều:

Sub GetImages()
  Dim oFile As Object
  Dim pic As Picture
  Dim cel As Range
  Dim wks As Worksheet
  Dim sPath As String, sExt As String
  Dim idx As Long
  Const IMG_FILTER As String = "/JPG/GIF/JFIF/PNG/"
  'On Error Resume Next
  Set wks = Worksheets("Trang_t?nh1")
  wks.Range("C5:D1000").Clear
  idx = 4
  sPath = ThisWorkbook.Path
  With CreateObject("Scripting.FileSystemObject")
    For Each oFile In .GetFolder(sPath).Files
      sExt = .GetExtensionName(oFile)
      If InStr(1, IMG_FILTER, "/" & sExt & "/", vbTextCompare) Then
        idx = idx + 1
        wks.Cells(idx, 3) = idx - 4
        wks.Cells(idx, 4) = Left(oFile.Name, Len(oFile.Name) - Len(sExt) - 1)
        wks.Cells(idx, 4).ID = oFile
        Set cel = wks.Cells(idx, 5)
        On Error Resume Next
        wks.Pictures("Pic" & cel.Address).Delete
        On Error GoTo 0
        Set pic = wks.Pictures.Insert(oFile.Path)
        pic.ShapeRange.LockAspectRatio = msoFalse
        pic.Name = "Pic" & cel.Address
        pic.Left = cel.Left: pic.Top = cel.Top
        pic.Width = cel.Width: pic.Height = cel.Height
        pic.ShapeRange.ScaleHeight 0.8, msoFalse, msoScaleFromMiddle
        pic.ShapeRange.ScaleWidth 0.8, msoFalse, msoScaleFromMiddle
      End If
    Next
  End With
End Sub

(thêm phần chèn hình)

 

[Kieutri]

Bài toán của bạn khác với yêu cầu của chủ đề này
Theo ý bạn thì code phải sửa lại hơi nhiều:

Sub GetImages()
  Dim oFile As Object
  Dim pic As Picture
  Dim cel As Range
  Dim wks As Worksheet
  Dim sPath As String, sExt As String
  Dim idx As Long
  Const IMG_FILTER As String = "/JPG/GIF/JFIF/PNG/"
  'On Error Resume Next
  Set wks = Worksheets("Trang_t?nh1")
  wks.Range("C5:D1000").Clear
  idx = 4
  sPath = ThisWorkbook.Path
  With CreateObject("Scripting.FileSystemObject")
    For Each oFile In .GetFolder(sPath).Files
      sExt = .GetExtensionName(oFile)
      If InStr(1, IMG_FILTER, "/" & sExt & "/", vbTextCompare) Then
        idx = idx + 1
        wks.Cells(idx, 3) = idx - 4
        wks.Cells(idx, 4) = Left(oFile.Name, Len(oFile.Name) - Len(sExt) - 1)
        wks.Cells(idx, 4).ID = oFile
        Set cel = wks.Cells(idx, 5)
        On Error Resume Next
        wks.Pictures("Pic" & cel.Address).Delete
        On Error GoTo 0
        Set pic = wks.Pictures.Insert(oFile.Path)
        pic.ShapeRange.LockAspectRatio = msoFalse
        pic.Name = "Pic" & cel.Address
        pic.Left = cel.Left: pic.Top = cel.Top
        pic.Width = cel.Width: pic.Height = cel.Height
        pic.ShapeRange.ScaleHeight 0.8, msoFalse, msoScaleFromMiddle
        pic.ShapeRange.ScaleWidth 0.8, msoFalse, msoScaleFromMiddle
      End If
    Next
  End With
End Sub

(thêm phần chèn hình)

E cảm ơn anh, anh ơi đoạn code này em code vào Module hay This book vậy anh.

 

[xuantocdotb]

Làm cho bạn luôn đây
1> Code trong module:

Sub GetImages()
  Dim oFile As Object
  Dim sPath As String, sExt As String
  Dim idx As Long
  Const IMG_FILTER As String = "/JPG/GIF/JFIF/PNG/"
  'On Error Resume Next
  Range("C5:D1000").Clear
  idx = 4
  sPath = ThisWorkbook.Path
  With CreateObject("Scripting.FileSystemObject")
    For Each oFile In .GetFolder(sPath).Files
      sExt = .GetExtensionName(oFile)
      If InStr(1, IMG_FILTER, "/" & sExt & "/", vbTextCompare) Then
        idx = idx + 1
        Cells(idx, 3) = idx - 4
        Cells(idx, 4) = Left(oFile.Name, Len(oFile.Name) - Len(sExt) - 1)
        Cells(idx, 4).ID = oFile
      End If
    Next
  End With
End Sub

2> Code trong sự kiện SectionChange

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim FSO As Object
  Set FSO = CreateObject("Scripting.FileSystemObject")
  'On Error Resume Next
  If Not Intersect(Range("D5:D1000"), Target) Is Nothing Then
    If Target.Count = 1 Then
      If FSO.FileExists(Target.ID) Then Shell "Explorer.exe /Select, " & """" & Target.ID & """", 1
    End If
  End If
End Sub

Với file đuôi ".pdf" thì có ứng dung được code trên không thưa thầy?

 

[ndu96081631]

Với file đuôi ".pdf" thì có ứng dung được code trên không thưa thầy?

Được nhưng chỉ dừng ở mức lấy tên file vào tạo liên kết thôi nha. Đương nhiên pdf không phải hình nên chẳng thể "hiển thị" được

Bài đã được tự động gộp: 3/12/19

E cảm ơn anh, anh ơi đoạn code này em code vào Module hay This book vậy anh.

Không nói gì nghĩa là cho vào module đó bạn

 

[Kieutri]

Được nhưng chỉ dừng ở mức lấy tên file vào tạo liên kết thôi nha. Đương nhiên pdf không phải hình nên chẳng thể "hiển thị" được

Bài đã được tự động gộp: 3/12/19

Không nói gì nghĩa là cho vào module đó bạn

Em có copy đoạn code anh gửi dán vào module mà không được anh ạ. Em đang thao tác sai ở đoạn nào. a sửa giúp em với ạ. Chủ đề này hay quá. Em cảm ơn anh nhiều.

 

[xuantocdotb]

Được nhưng chỉ dừng ở mức lấy tên file vào tạo liên kết thôi nha. Đương nhiên pdf không phải hình nên chẳng thể "hiển thị" được

Bài đã được tự động gộp: 3/12/19

Không nói gì nghĩa là cho vào module đó bạn

Em cảm ơn thầy!

 

[ndu96081631]

Em có copy đoạn code anh gửi dán vào module mà không được anh ạ. Em đang thao tác sai ở đoạn nào. a sửa giúp em với ạ. Chủ đề này hay quá. Em cảm ơn anh nhiều.

Có 2 chỗ sai:
1> Bạn copy vô bị dư dòng "End Sub" (đang có 2 cái End Sub)
2> Tôi sai: Chẳng biết copy paste thế nào mà Set wks = Worksheets("Trang_tính1") lại trở thành Set wks = Worksheets("Trang_t?nh1") <--- Cái "Trang_tính1" chính là tên sheet của bạn đó <--- Sửa lại giúp tôi nhé
3> Cuối cùng thì: Thôi tôi sửa cho bạn luôn đây

 

[Kieutri]

Có 2 chỗ sai:
1> Bạn copy vô bị dư dòng "End Sub" (đang có 2 cái End Sub)
2> Tôi sai: Chẳng biết copy paste thế nào mà Set wks = Worksheets("Trang_tính1") lại trở thành Set wks = Worksheets("Trang_t?nh1") <--- Cái "Trang_tính1" chính là tên sheet của bạn đó <--- Sửa lại giúp tôi nhé
3> Cuối cùng thì: Thôi tôi sửa cho bạn luôn đây

Có 2 chỗ sai:
1> Bạn copy vô bị dư dòng "End Sub" (đang có 2 cái End Sub)
2> Tôi sai: Chẳng biết copy paste thế nào mà Set wks = Worksheets("Trang_tính1") lại trở thành Set wks = Worksheets("Trang_t?nh1") <--- Cái "Trang_tính1" chính là tên sheet của bạn đó <--- Sửa lại giúp tôi nhé
3> Cuối cùng thì: Thôi tôi sửa cho bạn luôn đây

Em cảm ơn anh rất nhiều. Tuyệt quá anh ạ.

 

[batman1]

Em cảm ơn anh rất nhiều. Tuyệt quá anh ạ.

Code chưa đủ đâu. Bạn hãy đóng tập tin rồi mở lại. Sau đó chọn vd. D5 thì bạn biết tôi nói gì.

cell.ID chỉ tồn tại cho tới khi đóng tập tin. Khi mở tập tin thì mọi cell.ID đều là mặc định, tức chuỗi rỗng.

 

[xuantocdotb]

Code chưa đủ đâu. Bạn hãy đóng tập tin rồi mở lại. Sau đó chọn vd. D5 thì bạn biết tôi nói gì.

cell.ID chỉ tồn tại cho tới khi đóng tập tin. Khi mở tập tin thì mọi cell.ID đều là mặc định, tức chuỗi rỗng.

Dạ đúng ạ! Anh chỉnh lại giúp em được không ạ?
Cảm ơn anh!

 

[batman1]

Dạ đúng ạ! Anh chỉnh lại giúp em được không ạ?
Cảm ơn anh!

Tác giả "có nhà" thì tại sao bạn lại nhờ tôi?

 

[xuantocdotb]

Tác giả "có nhà" thì tại sao bạn lại nhờ tôi?

Có thể thầy ndu96081631 bận công việc gì đó mà chưa có thời gian vào GPE.
Em nhờ anh luôn! hi

 

[batman1]

Có thể thầy ndu96081631 bận công việc gì đó mà chưa có thời gian vào GPE.
Em nhờ anh luôn! hi

Tôi thức quá khuya rồi (hiện chỗ tôi là 3 giờ sáng). Tôi đi ngủ đây.

 

[xuantocdotb]

Tôi thức quá khuya rồi (hiện chỗ tôi là 3 giờ sáng). Tôi đi ngủ đây.

Vâng, chắc anh công tác ở nước ngoài nên múi giờ khác bên Việt Nam.
Chúc anh ngủ ngon!

 

[Kieutri]

Code chưa đủ đâu. Bạn hãy đóng tập tin rồi mở lại. Sau đó chọn vd. D5 thì bạn biết tôi nói gì.

cell.ID chỉ tồn tại cho tới khi đóng tập tin. Khi mở tập tin thì mọi cell.ID đều là mặc định, tức chuỗi rỗng.

Em đóng vào, thấy code vẫn chạy bình thường mà anh. File vẫn chạy kể cả khi copy sang 1 folder khác ạ.