Đổi Tên Hình Theo Dữ Liệu

vuongtoituonglai · 25/4/19

Xin chào diễn đàn GPE,
Tôi đang có một thư mục chứa rất nhiều hình và tên hình tôi đang đặt tên giống như cột B file excel. Bây giờ tôi có mong muốn nhờ diễn đàn giúp đở đổi tên hình giống cột C file excel. Rất mong nhận được sự giúp đở của diễn đàn.
Tôi chân thành cảm ơn.

LamNA · 25/4/19

vuongtoituonglai đã viết:
Xin chào diễn đàn GPE,
Tôi đang có một thư mục chứa rất nhiều hình và tên hình tôi đang đặt tên giống như cột B file excel. Bây giờ tôi có mong muốn nhờ diễn đàn giúp đở đổi tên hình giống cột C file excel. Rất mong nhận được sự giúp đở của diễn đàn.
Tôi chân thành cảm ơn.

Bạn thử file này

leonguyenz · 25/4/19

vuongtoituonglai đã viết:
Xin chào diễn đàn GPE,
Tôi đang có một thư mục chứa rất nhiều hình và tên hình tôi đang đặt tên giống như cột B file excel. Bây giờ tôi có mong muốn nhờ diễn đàn giúp đở đổi tên hình giống cột C file excel. Rất mong nhận được sự giúp đở của diễn đàn.
Tôi chân thành cảm ơn.

Tham khảo thêm code và file đính kèm

Mã:

Sub Button1_Click()
Dim Fder As String, Rng As Range, i As Integer, c As Integer
Set Rng = Sheet1.Range("B2:C" & Sheet1.Range("C65535").End(xlUp).Row)
Fder = Application.ActiveWorkbook.Path
For i = 1 To Rng.Rows.Count
    If Dir(Fder & "\" & Rng(i, 1) & ".jpg") <> "" Then
        c = c + 1
        Name Fder & "\" & Rng(i, 1) & ".jpg" As _
            Fder & "\" & Rng(i, 2) & ".jpg"
    End If
Next i
If c Then
    MsgBox "Hoàn thành " & c & " hình"
Else
    MsgBox "Không có hình nào"
End If
End Sub

vuongtoituonglai · 26/4/19

LamNA đã viết:
Bạn thử file này

Cảm ơn bạn nhiều nhé

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

leonguyenz đã viết:

Tham khảo thêm code và file đính kèm

Mã:

Sub Button1_Click()
Dim Fder As String, Rng As Range, i As Integer, c As Integer
Set Rng = Sheet1.Range("B2:C" & Sheet1.Range("C65535").End(xlUp).Row)
Fder = Application.ActiveWorkbook.Path
For i = 1 To Rng.Rows.Count
    If Dir(Fder & "\" & Rng(i, 1) & ".jpg") <> "" Then
        c = c + 1
        Name Fder & "\" & Rng(i, 1) & ".jpg" As _
            Fder & "\" & Rng(i, 2) & ".jpg"
    End If
Next i
If c Then
    MsgBox "Hoàn thành " & c & " hình"
Else
    MsgBox "Không có hình nào"
End If
End Sub

leonguyenz Cảm ơn bạn nhé. Để mình sử dụng nếu có vấn đề gì chưa ổn mình nhờ bạn hỗ trợ tiếp nhé.

Chân thành cảm ơn

vuongtoituonglai · 25/9/19

leonguyenz đã viết:

Tham khảo thêm code và file đính kèm

Mã:

Sub Button1_Click()
Dim Fder As String, Rng As Range, i As Integer, c As Integer
Set Rng = Sheet1.Range("B2:C" & Sheet1.Range("C65535").End(xlUp).Row)
Fder = Application.ActiveWorkbook.Path
For i = 1 To Rng.Rows.Count
    If Dir(Fder & "\" & Rng(i, 1) & ".jpg") <> "" Then
        c = c + 1
        Name Fder & "\" & Rng(i, 1) & ".jpg" As _
            Fder & "\" & Rng(i, 2) & ".jpg"
    End If
Next i
If c Then
    MsgBox "Hoàn thành " & c & " hình"
Else
    MsgBox "Không có hình nào"
End If
End Sub

Mình có vấn đề nên nhờ bạn xem qua và tiếp tục giúp đỡ mình.
1. Hiện kết quả sao khi đổi tên hình vào file Excel(giống như file mẫu mình làm)
2. Hình sẽ có nhiều đuôi như jbg, bmp, pnj
Rất mong nhận được sự giúp đỡ
Chân thành cảm ơn

vuongtoituonglai · 25/9/19

Mình đang gặp vấn đề tại bài #5, các bạn xem qua và mình với.
Cảm ơn các bạn

vuongtoituonglai · 28/9/19

vuongtoituonglai đã viết:
Mình đang gặp vấn đề tại bài #5, các bạn xem qua và mình với.
Cảm ơn các bạn

Đã 2 ngày trôi qua không nhận được sự giúp đỡ của các thành viên GPE.
Anh chị và các bạn xem qua và giúp đỡ mình đề tài này.
Cảm ơn.

batman1 · 28/9/19

vuongtoituonglai đã viết:
Đã 2 ngày trôi qua không nhận được sự giúp đỡ của các thành viên GPE.

Bạn viết

O: đổi thành công
X: không đổi được

Có nghĩa là bất luận nguyên nhân "không đổi được" là gì thì là X? Không lăn tăn chuyện nguyên nhân?

Tôi có thể nghĩ ra 3 trường hợp mà code của leonguyenz không đổi được tên. Lấy vd. đổi 00123 thành 123456789.
1. Nếu 00123 có thuộc tính Hide = True thì không đổi được.
2. Nếu trong thư mục cũng đã có 123456789 thì không thể đổi 00123 thành 123456789 được.
3. Nếu trong đường dẫn có ký tự Việt thì cũng không đổi được.

Bạn chắc chắn không có trường hợp nào? Hay cả 3 trường hợp và có thể cả những trường hợp mà tôi chưa liệt kê đều có thể sảy ra?

Nhưng đấy là chuyện nhỏ như con thỏ. Còn nữa. Bạn viết

2. Hình sẽ có nhiều đuôi như jbg, bmp, pnj

Tôi hiểu là JPG, BMP và PNG, vì không có JBG, PNJ.
Nhưng giả sử trong thư mục có 00123.jpg, 00123.bmp và 00123.png thì đổi tên tập tin JPG, BMP hay PNG? Nếu bạn muốn đổi tên cả 3 nếu có cả 3 thì lại có câu hỏi tiếp. Giả sử đã có 123456789.bmp và 123456789.png. Vậy thì đổi JPG thành công còn đổi BMP và PNG không thành công. Vậy thì trong E2 sẽ phải là "O" hay "X"?

Hỏi thì cũng phải suy nghĩ thấu đáo và giải thích kỹ. Không chỉ vài câu cụt lủn và tung tập tin lên rồi mong câu trả lời chính xác, code chính xác được.

vuongtoituonglai · 28/9/19

batman1 đã viết:
Bạn viết

Có nghĩa là bất luận nguyên nhân "không đổi được" là gì thì là X? Không lăn tăn chuyện nguyên nhân?

Tôi có thể nghĩ ra 3 trường hợp mà code của leonguyenz không đổi được tên. Lấy vd. đổi 00123 thành 123456789.
1. Nếu 00123 có thuộc tính Hide = True thì không đổi được.
2. Nếu trong thư mục cũng đã có 123456789 thì không thể đổi 00123 thành 123456789 được.
3. Nếu trong đường dẫn có ký tự Việt thì cũng không đổi được.

Bạn chắc chắn không có trường hợp nào? Hay cả 3 trường hợp và có thể cả những trường hợp mà tôi chưa liệt kê đều có thể sảy ra?

Nhưng đấy là chuyện nhỏ như con thỏ. Còn nữa. Bạn viết

Tôi hiểu là JPG, BMP và PNG, vì không có JBG, PNJ.
Nhưng giả sử trong thư mục có 00123.jpg, 00123.bmp và 00123.png thì đổi tên tập tin JPG, BMP hay PNG? Nếu bạn muốn đổi tên cả 3 nếu có cả 3 thì lại có câu hỏi tiếp. Giả sử đã có 123456789.bmp và 123456789.png. Vậy thì đổi JPG thành công còn đổi BMP và PNG không thành công. Vậy thì trong E2 sẽ phải là "O" hay "X"?

Hỏi thì cũng phải suy nghĩ thấu đáo và giải thích kỹ. Không chỉ vài câu cụt lủn và tung tập tin lên rồi mong câu trả lời chính xác, code chính xác được.

Cảm ơn bạn đã quan tâm.
Đúng như bạn đã nói nếu không đổi được thì ghi là X bất kể đó là lý do gì.
Trong trường hợp 1 hình có nhiều đuôi ví dụ như 0123.jpg, 0123.bmp thì chỉ cần đổi 1 hình và kết quả sẽ ghi là O
Cả 3 trường hợp 1,2,3 bạn đã nêu ra mình chắc chắn không có trường hợp nào xãy ra
Còn việc viết sai tên đuôi hình thì mình thật là sơ ý quá. Bạn thông cảm.
Mình mong sẽ nhận được sự giúp đỡ của bạn.
Chân thành cảm ơn

batman1 · 28/9/19

vuongtoituonglai đã viết:
Cảm ơn bạn đã quan tâm.
Đúng như bạn đã nói nếu không đổi được thì ghi là X bất kể đó là lý do gì.
Trong trường hợp 1 hình có nhiều đuôi ví dụ như 0123.jpg, 0123.bmp thì chỉ cần đổi 1 hình và kết quả sẽ ghi là O
Cả 3 trường hợp 1,2,3 bạn đã nêu ra mình chắc chắn không có trường hợp nào xãy ra

Code phục vụ cả 3 trường hợp mà tôi liệt kê. Biết đâu một ngày đẹp trời bạn hoặc ai đó lại nhờ sửa code để phục vụ những trường hợp đó. Lúc đó có phải méo mặt không. Cũng cùng một công viết code.

Với mỗi tên hiện hành code làm các việc sau. Trước tiên kiểm tra xem tập tin JPG có tồn tai không. Nếu không tồn tại thì kiểm tra BMP, PNG có tồn tại không. Nếu JPG, BMP hoặc PNG tồn tại thì kiểm tra tập tin mới và cũng có định dạng tương tự có tồn tại không. Nếu tồn tại thì kiểm tra định dạng tiếp theo. Nếu không tồn tại thì thử đổi tên. Nếu đổi tên thành công thì ngừng, ngược lại thì xét định dạng tiếp theo.

Tôi chỉ xét 3 định dạng: JPG, BMP, PNG. Nếu muốn thêm định dạng thì viết tiếp vào

Mã:

ext = Array(".jpg", ".bmp", ".png")

Tôi ngại test nên bạn tự kiểm tra.

Mã:

Sub Button1_Click()
Dim lastRow As Long, r As Long, k As Long, cu7 As String, moi As String, data(), result(), fso As Object, ext
    With ThisWorkbook.Worksheets("Sheet1")
        .Range("E2:E1000").ClearContents
        lastRow = .Cells(Rows.Count, "B").End(xlUp).Row
        If lastRow < 2 Then Exit Sub
        data = .Range("B2:C" & lastRow).Value
    End With
    ReDim result(1 To UBound(data), 1 To 1)
    ext = Array(".jpg", ".bmp", ".png")
    Set fso = CreateObject("Scripting.FileSystemObject")
    For r = 1 To UBound(data)
        For k = LBound(ext) To UBound(ext)
            cu = ThisWorkbook.Path & "\" & data(r, 1) & ext(k)
            If fso.FileExists(cu) Then
                moi = ThisWorkbook.Path & "\" & data(r, 2) & ext(k)
                If Not fso.FileExists(moi) Then
                    fso.MoveFile cu, moi
                    If fso.FileExists(moi) Then
                        result(r, 1) = "O"
                    Else
                        result(r, 1) = "X"
                    End If
                End If
            End If
            If result(r, 1) = "O" Then Exit For
        Next k
        If result(r, 1) <> "O" Then result(r, 1) = "X"
    Next r
    ThisWorkbook.Worksheets("Sheet1").Range("E2").Resize(UBound(result)).Value = result
    Set fso = Nothing
End Sub

vuongtoituonglai · 29/9/19

batman1 đã viết:
Code phục vụ cả 3 trường hợp mà tôi liệt kê. Biết đâu một ngày đẹp trời bạn hoặc ai đó lại nhờ sửa code để phục vụ những trường hợp đó. Lúc đó có phải méo mặt không. Cũng cùng một công viết code.

Với mỗi tên hiện hành code làm các việc sau. Trước tiên kiểm tra xem tập tin JPG có tồn tai không. Nếu không tồn tại thì kiểm tra BMP, PNG có tồn tại không. Nếu JPG, BMP hoặc PNG tồn tại thì kiểm tra tập tin mới và cũng có định dạng tương tự có tồn tại không. Nếu tồn tại thì kiểm tra định dạng tiếp theo. Nếu không tồn tại thì thử đổi tên. Nếu đổi tên thành công thì ngừng, ngược lại thì xét định dạng tiếp theo.

Tôi chỉ xét 3 định dạng: JPG, BMP, PNG. Nếu muốn thêm định dạng thì viết tiếp vào

Mã:

ext = Array(".jpg", ".bmp", ".png")

Tôi ngại test nên bạn tự kiểm tra.

Mã:

Sub Button1_Click() Dim lastRow As Long, r As Long, k As Long, cu7 As String, moi As String, data(), result(), fso As Object, ext With ThisWorkbook.Worksheets("Sheet1") .Range("E2:E1000").ClearContents lastRow = .Cells(Rows.Count, "B").End(xlUp).Row If lastRow < 2 Then Exit Sub data = .Range("B2:C" & lastRow).Value End With ReDim result(1 To UBound(data), 1 To 1) ext = Array(".jpg", ".bmp", ".png") Set fso = CreateObject("Scripting.FileSystemObject") For r = 1 To UBound(data) For k = LBound(ext) To UBound(ext) cu = ThisWorkbook.Path & "\" & data(r, 1) & ext(k) If fso.FileExists(cu) Then moi = ThisWorkbook.Path & "\" & data(r, 2) & ext(k) If Not fso.FileExists(moi) Then fso.MoveFile cu, moi If fso.FileExists(moi) Then result(r, 1) = "O" Else result(r, 1) = "X" End If End If End If If result(r, 1) = "O" Then Exit For Next k If result(r, 1) <> "O" Then result(r, 1) = "X" Next r ThisWorkbook.Worksheets("Sheet1").Range("E2").Resize(UBound(result)).Value = result Set fso = Nothing End Sub

Cảm ơn bạn đã giúp đỡ.
Mình đã thử test thì không thấy lỗi phát sinh.
Trong quá trình sử dụng không biết có còn tình huống nào phải chỉnh sửa code hay không thì mình cũng chưa nghỉ ra.
Ở thời điểm hiện tại thì code đã hoàn thiện rồi.
Chúc bạn ngày nghỉ cuối tuần thật vui vẻ và hạnh phúc.
Trân trọng cảm ơn.

Đổi Tên Hình Theo Dữ Liệu

vuongtoituonglai

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

File đính kèm

LamNA

Thành viên tích cực

File đính kèm

leonguyenz

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

File đính kèm

vuongtoituonglai

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

vuongtoituonglai

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

File đính kèm

vuongtoituonglai

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

vuongtoituonglai

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

batman1

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

vuongtoituonglai

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

batman1

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

vuongtoituonglai

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

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng