تلوين خليه لو وجد مجلد اسمه بنفس قيمه الخليه

[تامر خليفه]

السلام عليكم ورحمة الله وبركاته وبها نبدأ 

مرحباً

هل يمكن ان يقوم الاكسيل بتلوين خليه لو وجد مجلد اسمه بنفس قيمه الخليه

لا اعلم هل سؤالي واضح ؟

 

مثلا

عندي جدول في كل خليه اسم عميل ولكل عميل مجلد باسمه

اريد ان اعرف هل للعميل مجلد ام لا

لو موجود مجلد بنفس اسمه في الخليه يقوم الاكسيل بتلوينها

مرفق مثال في المرفقات

العملاء.rar

[تامر خليفه]

UP pls

[lionheart]

Try this code

Sub Test()
    Dim ws As Worksheet, fso As Object, sPath As String, lr As Long, iRow As Long
    Set ws = ActiveSheet
    Set fso = CreateObject("Scripting.FileSystemObject")
    lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
    ws.Columns(1).Interior.Color = xlNone
    For iRow = 2 To lr
        sPath = ThisWorkbook.Path & "\" & ws.Cells(iRow, 1).Value
        If fso.FolderExists(sPath) Then
            ws.Cells(iRow, 1).Interior.Color = vbGreen
        End If
    Next iRow
End Sub

 

[تامر خليفه]

9 دقائق مضت, lionheart said:

Try this code

Sub Test()
    Dim ws As Worksheet, fso As Object, sPath As String, lr As Long, iRow As Long
    Set ws = ActiveSheet
    Set fso = CreateObject("Scripting.FileSystemObject")
    lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
    ws.Columns(1).Interior.Color = xlNone
    For iRow = 2 To lr
        sPath = ThisWorkbook.Path & "\" & ws.Cells(iRow, 1).Value
        If fso.FolderExists(sPath) Then
            ws.Cells(iRow, 1).Interior.Color = vbGreen
        End If
    Next iRow
End Sub

 

شكرا لحضرتك ، لو امكن حضرتك تحط الكود في المثال المرفق لاني جربته عندي ومش شغال

[lionheart]

Do it yourself
Press Alt + F11 >> Insert Module >> Paste the code