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 đó (1 người xem)

vc_đi chơi · 30/11/19

Em có các bức ảnh (bao gồm tất cả các đuôi có định dạng file ảnh: JPEG, TIFF, GIF và PNG , vv.....) và file excel chứa trong cùng một folder
Em xin được nhờ giúp đỡ vấn đề sau:
Lấy tên file ảnh có chứa trong folder để điền vào cột "Nội dung" trong file excel
Điền theo trình tự chữ cái A, B, C,...., khi điền thì tự động đánh số thứ tự ở cột "Số TT" trong excel.
Khi dữ liệu đã được điền xong thì có thể mở bức ảnh đó bằng cách clik chọn vào ô có chứa nội dung trông cột "Nội dung".
Mong sự giúp đỡ của các thầy (cô), anh (chị).
Em xin cảm ơn!

thucuc1808 · 30/11/19

Mình tải dữ liệu ngân hàng từ internetbangking xuống lưu định dạng file excel, nhưng các dãy số phát sinh ngăn cách hàng ngàn bằng dấu chấm nên không sum tổng được. Mình muốn nhập dữ liệu này vô phần mềm phải làm thủ công xóa từng dấu chấm mới được. Bạn cá cách nào giúp mình , mình vô cùng cảm ơn

huonglien1901 · 30/11/19

thucuc1808 đã viết:
Mình tải dữ liệu ngân hàng từ internetbangking xuống lưu định dạng file excel, nhưng các dãy số phát sinh ngăn cách hàng ngàn bằng dấu chấm nên không sum tổng được. Mình muốn nhập dữ liệu này vô phần mềm phải làm thủ công xóa từng dấu chấm mới được. Bạn cá cách nào giúp mình , mình vô cùng cảm ơn

Bạn nên đặt một tiêu đề mới. Đừng chen ngang vào bài này. Bạn tạo 01 file mới rồi gửi lên.

be_09 · 30/11/19

thucuc1808 đã viết:
Mình tải dữ liệu ngân hàng từ internetbangking xuống lưu định dạng file excel, nhưng các dãy số phát sinh ngăn cách hàng ngàn bằng dấu chấm nên không sum tổng được. Mình muốn nhập dữ liệu này vô phần mềm phải làm thủ công xóa từng dấu chấm mới được. Bạn cá cách nào giúp mình , mình vô cùng cảm ơn

Góp ý cho bạn:
Nội dung của bạn không cùng chủ đề với chủ Topic. Vì vậy, bạn nên mở Topic mới với tiêu đề "Giúp xử lý dữ liệu của File để có thể tính toán được"

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

vc_đi chơi đã viết:
Em có các bức ảnh (bao gồm tất cả các đuôi có định dạng file ảnh: JPEG, TIFF, GIF và PNG , vv.....) và file excel chứa trong cùng một folder
Em xin được nhờ giúp đỡ vấn đề sau:
Lấy tên file ảnh có chứa trong folder để điền vào cột "Nội dung" trong file excel
Điền theo trình tự chữ cái A, B, C,...., khi điền thì tự động đánh số thứ tự ở cột "Số TT" trong excel.
Khi dữ liệu đã được điền xong thì có thể mở bức ảnh đó bằng cách clik chọn vào ô có chứa nội dung trông cột "Nội dung".
Mong sự giúp đỡ của các thầy (cô), anh (chị).
Em xin cảm ơn!
View attachment 229276

Góp ý cho bạn:
Bạn không nên để tiêu đề nữa chừng như vậy, tiêu đề nên bắt đầu cột A.

giaiphap · 30/11/19

vc_đi chơi đã viết:
Em có các bức ảnh (bao gồm tất cả các đuôi có định dạng file ảnh: JPEG, TIFF, GIF và PNG , vv.....) và file excel chứa trong cùng một folder
Em xin được nhờ giúp đỡ vấn đề sau:
Lấy tên file ảnh có chứa trong folder để điền vào cột "Nội dung" trong file excel
Điền theo trình tự chữ cái A, B, C,...., khi điền thì tự động đánh số thứ tự ở cột "Số TT" trong excel.
Khi dữ liệu đã được điền xong thì có thể mở bức ảnh đó bằng cách clik chọn vào ô có chứa nội dung trông cột "Nội dung".
Mong sự giúp đỡ của các thầy (cô), anh (chị).
Em xin cảm ơn!
View attachment 229276

Dùng thử đoạn code này xem sao?

Mã:

Sub Add_Link()
    Dim xFSO As Object
    Dim xFolder As Object
    Dim xFile As Object
    Dim xPath As String
    Dim I As Integer
    Const fFilter As String = ";.jpg;.gif;.jfif;.png;"
    Range("C5:D" & (Range("D1000").End(xlUp).Row + 1)).Clear
    xPath = ThisWorkbook.Path
    Set xFSO = CreateObject("Scripting.FileSystemObject")
    Set xFolder = xFSO.GetFolder(xPath)
    I = 0
    For Each xFile In xFolder.Files
        If InStrRev(xFile.Name, ".") Then
            If InStr(fFilter, ";" & Right(xFile.Name, Len(xFile.Name) - InStrRev(xFile.Name, ".") + 1) & ";") Then
                I = I + 1
                Cells(I + 4, 3) = I
                ActiveSheet.Hyperlinks.Add Cells(I + 4, 4), xFile.Path, , , Left(xFile.Name, InStrRev(xFile.Name, ".") - 1)
            End If
        End If
    Next
End Sub

be_09 · 30/11/19

vc_đi chơi đã viết:
Em có các bức ảnh (bao gồm tất cả các đuôi có định dạng file ảnh: JPEG, TIFF, GIF và PNG , vv.....) và file excel chứa trong cùng một folder
Em xin được nhờ giúp đỡ vấn đề sau:
Lấy tên file ảnh có chứa trong folder để điền vào cột "Nội dung" trong file excel
Điền theo trình tự chữ cái A, B, C,...., khi điền thì tự động đánh số thứ tự ở cột "Số TT" trong excel.
Khi dữ liệu đã được điền xong thì có thể mở bức ảnh đó bằng cách clik chọn vào ô có chứa nội dung trông cột "Nội dung".
Mong sự giúp đỡ của các thầy (cô), anh (chị).
Em xin cảm ơn!
View attachment 229276

1/ File đính kèm như góp ý bài 4.
2/ Muốn lấy link ở Folder nào thì thay đường dẫn vào C2 rồi nhấn nút.

vc_đi chơi · 1/12/19

be09 đã viết:
1/ File đính kèm như góp ý bài 4.
2/ Muốn lấy link ở Folder nào thì thay đường dẫn vào C2 rồi nhấn nút.

Cám ơn thầy!

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

giaiphap đã viết:

Dùng thử đoạn code này xem sao?

Mã:

Sub Add_Link()
    Dim xFSO As Object
    Dim xFolder As Object
    Dim xFile As Object
    Dim xPath As String
    Dim I As Integer
    Const fFilter As String = ";.jpg;.gif;.jfif;.png;"
    Range("C5:D" & (Range("D1000").End(xlUp).Row + 1)).Clear
    xPath = ThisWorkbook.Path
    Set xFSO = CreateObject("Scripting.FileSystemObject")
    Set xFolder = xFSO.GetFolder(xPath)
    I = 0
    For Each xFile In xFolder.Files
        If InStrRev(xFile.Name, ".") Then
            If InStr(fFilter, ";" & Right(xFile.Name, Len(xFile.Name) - InStrRev(xFile.Name, ".") + 1) & ";") Then
                I = I + 1
                Cells(I + 4, 3) = I
                ActiveSheet.Hyperlinks.Add Cells(I + 4, 4), xFile.Path, , , Left(xFile.Name, InStrRev(xFile.Name, ".") - 1)
            End If
        End If
    Next
End Sub

Em cám ơn anh!

ndu96081631 · 1/12/19

giaiphap đã viết:

Dùng thử đoạn code này xem sao?

Mã:

Sub Add_Link()
    Dim xFSO As Object
    Dim xFolder As Object
    Dim xFile As Object
    Dim xPath As String
    Dim I As Integer
    Const fFilter As String = ";.jpg;.gif;.jfif;.png;"
    Range("C5:D" & (Range("D1000").End(xlUp).Row + 1)).Clear
    xPath = ThisWorkbook.Path
    Set xFSO = CreateObject("Scripting.FileSystemObject")
    Set xFolder = xFSO.GetFolder(xPath)
    I = 0
    For Each xFile In xFolder.Files
        If InStrRev(xFile.Name, ".") Then
            If InStr(fFilter, ";" & Right(xFile.Name, Len(xFile.Name) - InStrRev(xFile.Name, ".") + 1) & ";") Then
                I = I + 1
                Cells(I + 4, 3) = I
                ActiveSheet.Hyperlinks.Add Cells(I + 4, 4), xFile.Path, , , Left(xFile.Name, InStrRev(xFile.Name, ".") - 1)
            End If
        End If
    Next
End Sub

Chỗ này:

Mã:

If InStr(fFilter, ";" & Right(xFile.Name, Len(xFile.Name) - InStrRev(xFile.Name, ".") + 1) & ";")

Thay bằng

Mã:

If InStr(fFilter, ";." & xFSO.GetExtensionName(xFile) & ";") Then

Có được không?

Phuocam · 1/12/19

ndu96081631 đã viết:
Có được không?

Chào mừng Lão Ẹc ẹc đã quay trở lại diễn đàn. :clap2:

vc_đi chơi · 2/12/19

giaiphap đã viết:

Dùng thử đoạn code này xem sao?

Mã:

Sub Add_Link()
    Dim xFSO As Object
    Dim xFolder As Object
    Dim xFile As Object
    Dim xPath As String
    Dim I As Integer
    Const fFilter As String = ";.jpg;.gif;.jfif;.png;"
    Range("C5:D" & (Range("D1000").End(xlUp).Row + 1)).Clear
    xPath = ThisWorkbook.Path
    Set xFSO = CreateObject("Scripting.FileSystemObject")
    Set xFolder = xFSO.GetFolder(xPath)
    I = 0
    For Each xFile In xFolder.Files
        If InStrRev(xFile.Name, ".") Then
            If InStr(fFilter, ";" & Right(xFile.Name, Len(xFile.Name) - InStrRev(xFile.Name, ".") + 1) & ";") Then
                I = I + 1
                Cells(I + 4, 3) = I
                ActiveSheet.Hyperlinks.Add Cells(I + 4, 4), xFile.Path, , , Left(xFile.Name, InStrRev(xFile.Name, ".") - 1)
            End If
        End If
    Next
End Sub

Anh ơi, nhờ anh giúp em thêm chút, anh giúp em để có thể khi chọn ô nội dung bức ảnh đó sẽ dẫn đến vị trí bức ảnh đó mà không cần mở luôn file ảnh đó ra.
Em cảm ơn anh!

giaiphap · 2/12/19

ndu96081631 đã viết:
Chỗ này:

Mã:

If InStr(fFilter, ";" & Right(xFile.Name, Len(xFile.Name) - InStrRev(xFile.Name, ".") + 1) & ";")

Thay bằng

Mã:

If InStr(fFilter, ";." & xFSO.GetExtensionName(xFile) & ";") Then

Có được không?

Đã lâu rồi không thấy anh Tuấn (@ndu96081631 ) trở lại.

vc_đi chơi đã viết:
Anh ơi, nhờ anh giúp em thêm chút, anh giúp em để có thể khi chọn ô nội dung bức ảnh đó sẽ dẫn đến vị trí bức ảnh đó mà không cần mở luôn file ảnh đó ra.
Em cảm ơn anh!
View attachment 229333

Nếu mở đến thư mục đó thì được còn mở và chọn luôn file thì hơi quá sức của tôi.

ndu96081631 · 2/12/19

giaiphap đã viết:
Nếu mở đến thư mục đó thì được còn mở và chọn luôn file thì hơi quá sức của tôi.

Bạn hiền thử code này xem:

Mã:

Shell "Explorer.exe /Select, " & """" & Đường dẫn đến file & """", 1

vc_đi chơi · 2/12/19

giaiphap đã viết:
Đã lâu rồi không thấy anh Tuấn (@ndu96081631 ) trở lại.

Nếu mở đến thư mục đó thì được còn mở và chọn luôn file thì hơi quá sức của tôi.

Ý em là chọn đến file ảnh có nội dung thư mục đó (như hình em đăng bài #10) mà không cần mở trực tiếp file ảnh có nội dung đó ra.
Cám ơn anh!

ndu96081631 · 2/12/19

vc_đi chơi đã viết:
Ý em là chọn đến file ảnh có nội dung thư mục đó (như hình em đăng bài #10) mà không cần mở trực tiếp file ảnh có nội dung đó ra.
Cám ơn anh!

Thì chính là vậy đó mà (gợi ý ở bài 12)

Kiều Mạnh · 2/12/19

ndu96081631 đã viết:
Thì chính là vậy đó mà (gợi ý ở bài 12)

lâu lắm mới thấy Anh xuất hiện... cảm giác thấy lâng lâng & vui vui... vắng vẻ thấy buồn

vc_đi chơi · 2/12/19

ndu96081631 đã viết:
Thì chính là vậy đó mà (gợi ý ở bài 12)

Em có copy code vào thấy báo lỗi.
Em xin diễn đạt lái ý em cần giúp đỡ:
Em muốn khi chạy code sẽ lấy được tên file để điền vào nội dung trong cột"Nội dung" của excel
Khi chọn ô trong cột "Nội dung" đó sẽ chọn được file ảnh, ở trên thầy đã giúp em mở luôn file ảnh đó ra.
Cảm ơn thầy!

ndu96081631 · 2/12/19

vc_đi chơi đã viết:
Em có copy code vào thấy báo lỗi.
Em xin diễn đạt lái ý em cần giúp đỡ:
Em muốn khi chạy code sẽ lấy được tên file để điền vào nội dung trong cột"Nội dung" của excel
Khi chọn ô trong cột "Nội dung" đó sẽ chọn được file ảnh, ở trên thầy đã giúp em mở luôn file ảnh đó ra.
Cảm ơn thầy!

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

Mã:

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

Mã:

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

vc_đi chơi · 2/12/19

ndu96081631 đã viết:

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

Mã:

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

Mã:

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

Em cám ơn thầy!
Em chạy code thầy giúp thì đã lấy được tên nội dung file ảnh, nhưng làm thế nào có thể chọn nội dung đó trong excel để chọn được file ảnh tương ứng với nội dung đó ạ! (clik vào ô chứa nội dung trong excel sẽ chọn được file ảnh có nội dung tương ứng)

ndu96081631 · 2/12/19

vc_đi chơi đã viết:
Em cám ơn thầy!
Em chạy code thầy giúp thì đã lấy được tên nội dung file ảnh, nhưng làm thế nào có thể chọn nội dung đó trong excel để chọn được file ảnh tương ứng với nội dung đó ạ! (clik vào ô chứa nội dung trong excel sẽ chọn được file ảnh có nội dung tương ứng)

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

Kieutri · 2/12/19

ndu96081631 đã viết:

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

Mã:

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

Mã:

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

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ỉ? Ý em là hiện cả ảnh lên được không ạ.

vc_đi chơi · 2/12/19

ndu96081631 đã viết:
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 · 2/12/19

Kieutri đã viết:
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

vc_đi chơi đã viết:
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 · 2/12/19

ndu96081631 đã viết:
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 · 2/12/19

ndu96081631 đã viết:
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 · 2/12/19

vc_đi chơi đã viết:
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 · 2/12/19

Kieutri đã viết:
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:

Mã:

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 · 3/12/19

ndu96081631 đã viết:

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:

Mã:

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 · 3/12/19

ndu96081631 đã viết:

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

Mã:

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

Mã:

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 · 3/12/19

xuantocdotb đã viết:
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

Kieutri đã viết:
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 · 3/12/19

ndu96081631 đã viết:
Đượ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 · 3/12/19

ndu96081631 đã viết:
Đượ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 · 3/12/19

Kieutri đã viết:
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 · 3/12/19

ndu96081631 đã viết:
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 · 3/12/19

Kieutri đã viết:
Em cảm ơn anh rất nhiều. Tuyệt quá anh ạ.

Code chưa đủ đâu. Bạn hãy đóng tập tin rồi mở lại. Sau đó chọn vd. D5 thì bạn biết tôi nói gì.

cell.ID chỉ tồn tại cho tới khi đóng tập tin. Khi mở tập tin thì mọi cell.ID đều là mặc định, tức chuỗi rỗng.

xuantocdotb · 4/12/19

batman1 đã viết:
Code chưa đủ đâu. Bạn hãy đóng tập tin rồi mở lại. Sau đó chọn vd. D5 thì bạn biết tôi nói gì.

cell.ID chỉ tồn tại cho tới khi đóng tập tin. Khi mở tập tin thì mọi cell.ID đều là mặc đị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 · 4/12/19

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

Tác giả "có nhà" thì tại sao bạn lại nhờ tôi?

xuantocdotb · 4/12/19

batman1 đã viết:
Tác giả "có nhà" thì tại sao bạn lạ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 · 4/12/19

xuantocdotb đã viết:
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 quá khuya rồi (hiện chỗ tôi là 3 giờ sáng). Tôi đi ngủ đây.

xuantocdotb · 4/12/19

batman1 đã viết:
Tôi thức quá khuya rồi (hiện chỗ tôi là 3 giờ sáng). Tôi đi ngủ đâ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 · 4/12/19

batman1 đã viết:
Code chưa đủ đâu. Bạn hãy đóng tập tin rồi mở lại. Sau đó chọn vd. D5 thì bạn biết tôi nói gì.

cell.ID chỉ tồn tại cho tới khi đóng tập tin. Khi mở tập tin thì mọi cell.ID đều là mặc đị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 ạ.

batman1 · 4/12/19

Kieutri đã viết:
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 ạ.

Ý tôi thế này. Bạn mở tập tin rồi nhấn GetImages. Sau đó chọn 1 ô nội dung. Bạn sẽ thấy một folder mở ra và ảnh được chọn. Bây giờ bạn lưu tập tin rồi đóng nó. Sau đó lại mở ra rồi không nhấn GetImages nữa mà chọn 1 ô nội dung. Bạn sẽ thấy là không có folder nào được mở ra nữa.
Như vậy mỗi lần mở tập tin bạn lại phải nhấn GetImages để chạy code. Rách việc quá. Như thế thì code không nên gán cho nút GetImages mà nên cho vào Workbook_Open. Thế thôi.

vc_đi chơi · 4/12/19

batman1 đã viết:
Ý tôi thế này. Bạn mở tập tin rồi nhấn GetImages. Sau đó chọn 1 ô nội dung. Bạn sẽ thấy một folder mở ra và ảnh được chọn. Bây giờ bạn lưu tập tin rồi đóng nó. Sau đó lại mở ra rồi không nhấn GetImages nữa mà chọn 1 ô nội dung. Bạn sẽ thấy là không có folder nào được mở ra nữa.
Như vậy mỗi lần mở tập tin bạn lại phải nhấn GetImages để chạy code. Rách việc quá. Như thế thì code không nên gán cho nút GetImages mà nên cho vào Workbook_Open. Thế thôi.

Anh batman1 nói đúng đó, nhờ anh chỉnh lại giúp code cho bọn em mới nhé!

Kieutri · 4/12/19

batman1 đã viết:
Ý tôi thế này. Bạn mở tập tin rồi nhấn GetImages. Sau đó chọn 1 ô nội dung. Bạn sẽ thấy một folder mở ra và ảnh được chọn. Bây giờ bạn lưu tập tin rồi đóng nó. Sau đó lại mở ra rồi không nhấn GetImages nữa mà chọn 1 ô nội dung. Bạn sẽ thấy là không có folder nào được mở ra nữa.
Như vậy mỗi lần mở tập tin bạn lại phải nhấn GetImages để chạy code. Rách việc quá. Như thế thì code không nên gán cho nút GetImages mà nên cho vào Workbook_Open. Thế thôi.

Em cũng không hiểu mấy về code, nhờ anh và anh ndu sửa giúp em lại với. Đề tài rất hay và đang sôi nổi quá anh. Em cảm ơn anh rất nhiều.

batman1 · 4/12/19

vc_đi chơi đã viết:
Anh batman1 nói đúng đó, nhờ anh chỉnh lại giúp code cho bọn em mới nhé!

Thì tôi đã nói rồi mà. Bạn có 2 lựa chọn:
- đặt 1 nút GetImages như bây giờ và mỗi lần mở tập tin phải nhấn nút.
- gọi Sub GetImages trong vd. Workbook_Open. Tức: mở tập tin -> bỏ nút GetImages -> Alt + F11 -> đúp chuột vào ThisWorkbook -> dán code sau và lưu lại tập tin

Mã:

Private Sub Workbook_Open()
    GetImages
End Sub

-------------
Nếu nói như bạn Kieutri

File vẫn chạy kể cả khi copy sang 1 folder khác ạ

Thì phải ý thức rõ như sau - nói rõ thôi để khỏi bất ngờ nếu sảy ra những trường hợp mà tôi liệt kê:

Giả sử bạn chạy code bằng cách nhấn nút hoặc gọi GetImages trong Workbook_Open và có 10 ảnh, 10 nội dung. Nếu bây giờ bạn chỉ copy tập tin Excel sang 1 folder khác mà không là copy folder chứa tập tin Excel sang folder khác thì cho dù bạn có nút GetImages và bạn nhấn nó khi mở tập tin hay không có nút mà chỉ có code tôi ghi ở trên thì:
- nếu folder mới chứa tập tin Excel không có ảnh thì cột nội dung sẽ trống nhưng cột ảnh vẫn có 10 ảnh. Tất nhiên là 10 ảnh lỗi.
- nếu folder mới có ít hơn 10 ảnh, vd. chỉ có 8 ảnh thì cột nội dung chỉ có 8 nội dung nhưng cột ảnh vẫn có 10 ảnh - 8 ảnh mới và 2 ảnh lỗi.

Thậm chí nếu không copy tập tin Excel đi đâu nhưng một ngày đẹp trời bạn lỡ xóa 2 ảnh thì ngày đẹp trời hôm sau khi bạn mở tập tin Excel thì bạn vẫn có 10 ảnh - 8 ảnh tốt và 2 ảnh xấu (do đã xóa) trong khi cột nội dung chỉ có 8 nội dung.

Những cái tôi chỉ ra chỉ là đề phòng khi lỡ xóa ảnh, khi chỉ copy tập tin Excel sang chỗ khác. Tất nhiên những ảnh lỗi chỉ thừa và làm ngứa mắt thôi chứ không gây tác hại gì, không gây lỗi.

Nếu muốn sửa thì cũng rất dễ nhưng tôi không sửa đâu. Ở trên tôi chỉ nêu cách gọi sub GetImages. Còn sửa code của GetImages thì tôi không dám làm. Như thế là vi phạm quyền tác giả.

vc_đi chơi · 5/12/19

batman1 đã viết:
Thì tôi đã nói rồi mà. Bạn có 2 lựa chọn:
- đặt 1 nút GetImages như bây giờ và mỗi lần mở tập tin phải nhấn nút.
- gọi Sub GetImages trong vd. Workbook_Open. Tức: mở tập tin -> bỏ nút GetImages -> Alt + F11 -> đúp chuột vào ThisWorkbook -> dán code sau và lưu lại tập tin

Mã:

Private Sub Workbook_Open() GetImages End Sub

-------------
Nếu nói như bạn Kieutri

Thì phải ý thức rõ như sau - nói rõ thôi để khỏi bất ngờ nếu sảy ra những trường hợp mà tôi liệt kê:

Giả sử bạn chạy code bằng cách nhấn nút hoặc gọi GetImages trong Workbook_Open và có 10 ảnh, 10 nội dung. Nếu bây giờ bạn chỉ copy tập tin Excel sang 1 folder khác mà không là copy folder chứa tập tin Excel sang folder khác thì cho dù bạn có nút GetImages và bạn nhấn nó khi mở tập tin hay không có nút mà chỉ có code tôi ghi ở trên thì:
- nếu folder mới chứa tập tin Excel không có ảnh thì cột nội dung sẽ trống nhưng cột ảnh vẫn có 10 ảnh. Tất nhiên là 10 ảnh lỗi.
- nếu folder mới có ít hơn 10 ảnh, vd. chỉ có 8 ảnh thì cột nội dung chỉ có 8 nội dung nhưng cột ảnh vẫn có 10 ảnh - 8 ảnh mới và 2 ảnh lỗi.

Thậm chí nếu không copy tập tin Excel đi đâu nhưng một ngày đẹp trời bạn lỡ xóa 2 ảnh thì ngày đẹp trời hôm sau khi bạn mở tập tin Excel thì bạn vẫn có 10 ảnh - 8 ảnh tốt và 2 ảnh xấu (do đã xóa) trong khi cột nội dung chỉ có 8 nội dung.

Những cái tôi chỉ ra chỉ là đề phòng khi lỡ xóa ảnh, khi chỉ copy tập tin Excel sang chỗ khác. Tất nhiên những ảnh lỗi chỉ thừa và làm ngứa mắt thôi chứ không gây tác hại gì, không gây lỗi.

Nếu muốn sửa thì cũng rất dễ nhưng tôi không sửa đâu. Ở trên tôi chỉ nêu cách gọi sub GetImages. Còn sửa code của GetImages thì tôi không dám làm. Như thế là vi phạm quyền tác giả.

Cám ơn anh batman1 nhiều! à anh ơi cho em hỏi thêm chút anh chèn ký tự "->" bằng cách nào đó ạ? có phím tắ nào để chèn ký tự "->" vào GPE không anh?

batman1 · 5/12/19

vc_đi chơi đã viết:
Cám ơn anh batman1 nhiều! à anh ơi cho em hỏi thêm chút anh chèn ký tự "->" bằng cách nào đó ạ? có phím tắ nào để chèn ký tự "->" vào GPE không anh?

Đấy là 2 ký tự: "-" và ">".

Mà tôi không chèn gì trong GPE cả. Tôi thường có thói quen viết trong notepad. Sau đó thì copy / paste vào GPE thôi.

vc_đi chơi · 5/12/19

batman1 đã viết:
Đấy là 2 ký tự: "-" và ">".

Mà tôi không chèn gì trong GPE cả. Tôi thường có thói quen viết trong notepad. Sau đó thì copy / paste vào GPE thôi.

Vâng, cảm ơn anh!

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 đó (1 người xem)

Người dùng đang xem chủ đề này

Thành viên thường trực

File đính kèm

Thành viên mới

GPE là ngôi nhà thứ 2 của tôi!!!

Biên Hòa, Đồng Nai

==(^o^)==

Biên Hòa, Đồng Nai

File đính kèm

Thành viên thường trực

Huyền thoại GPE

Thành viên mới

Thành viên thường trực

==(^o^)==

Huyền thoại GPE

Thành viên thường trực

Huyền thoại GPE

I don't program, I beat code into submission!!!

Thành viên thường trực

Huyền thoại GPE

File đính kèm

Thành viên thường trực

Huyền thoại GPE

Thành viên hoạt động

Thành viên thường trực

File đính kèm

Huyền thoại GPE

Thành viên hoạt động

File đính kèm

Thành viên thường trực

Huyền thoại GPE

Huyền thoại GPE

Thành viên hoạt động

Thành viên chính thức

Huyền thoại GPE

Thành viên hoạt động

File đính kèm

Thành viên chính thức

Huyền thoại GPE

File đính kèm

Thành viên hoạt động

Thành viên gạo cội

Thành viên chính thức

Thành viên gạo cội

Thành viên chính thức

Thành viên gạo cội

Thành viên chính thức

Thành viên hoạt động

Thành viên gạo cội

Thành viên thường trực

Thành viên hoạt động

Thành viên gạo cội

Thành viên thường trực

Thành viên gạo cội

Thành viên thường trực

Thời gian đếm ngược.