Как заблокировать ячейки для всех файлов в папке, которая имеет подпапки - PullRequest
Новая
       11

Как заблокировать ячейки для всех файлов в папке, которая имеет подпапки

1 голос
/ 09 ноября 2019

У меня есть 100 файлов Excel. Они находятся в подпапках. Каждая подпапка содержит 10-15 файлов Excel.

Я хотел бы заблокировать ячейки A1: A10 для всех 100 файлов в подпапках.

Я использовал VBA.

Это разные пути, например, C: \ Users \ mmishal001 \ Рабочий стол \ Попытка PT проекта 3 \ DEMO2 для VBA \ Director 1 \ Manager 1 C: \ Users \ mmishal001 \ Рабочий стол \ Попытка PT проекта 3 \DEMO2 для VBA \ Director 1 \ Manager 2 C: \ Users \ mmishal001 \ Desktop \ Попытка PT проекта 3 \ DEMO2 для VBA \ Director 2 \ Manager 3 C: \ Users \ mmishal001 \ Desktop \ Попытка PT проекта 3 \ DEMO2 для VBA \Director 2 \ Manager 4

Каждый из них имеет 10-15 файлов.

Я использовал приведенный ниже код для записи в файлы - был бы признателен, если бы вы могли отредактировать приведенный ниже код для блокировкиЯчейки A1: A10 для всех файлов Excel в указанных выше подпапках без необходимости повторной записи функций (может быть, цикл?) 

Sub TextInAll()
Dim my_files As String
Dim folder_path As String
Dim subfolder As String
Dim wb As Workbook
Dim ws As Worksheet
'Assign path to variable
folder_path = "C:\Users\mmishal001\Desktop\Project PT Attempt 3\DEMO2 for 
VBA\Director 1\Manager 1"
'specifying file types or extn.
my_files = Dir(folder_path & "\*.xlsx")
Do While my_files <> vbNullString
    Set wb = Workbooks.Open(folder_path & "\" & my_files)
    Set ws = wb.Sheets(1)
    ws.Range("A1:A5").Value = "mahir"
    wb.Close True
    my_files = Dir()
Loop
MsgBox ("All files are updated")
End Sub

Я ожидаю, что один код выполняется. Когда я перехожу к любому из 100 файлов в подпапках - диапазон ячеек A1: A10 заблокирован в каждом из файлов.

1 Ответ

0 голосов
/ 09 ноября 2019

Я понял это следующим образом. Просто измените Do Do Loop следующим образом: 

Do While my_files <> vbNullString
    Set wb = Workbooks.Open(folder_path & "\" & my_files)
    Set ws = wb.Sheets(1)
    ws.Range("A1:A5").Value = "mahir"

    ' This is the code to insert
    With ws
        .Cells.Locked = True
        .Range("A1:A10").Locked = False
        .Protect ""  'No password but protected. 
    End With

    wb.Close True
    my_files = Dir()
Loop

Обновление : на основании информации в сообщении вы можете сделать что-то подобное 

Sub TextInAll()
    Dim my_files As String
    Dim folder_path As Variant
    Dim subfolder As String
    Dim wb As Workbook
    Dim ws As Worksheet

    Dim vFiles As Variant
    vFiles = Array("C:\Users\mmishal001\Desktop\Project PT Attempt 3\DEMO2 for VBA\Director 1\Manager 1", _
        "C:\Users\mmishal001\Desktop\Project PT Attempt 3\DEMO2 for VBA\Director 1\Manager 2", _
        "C:\Users\mmishal001\Desktop\Project PT Attempt 3\DEMO2 for VBA\Director 2\Manager 3", _
        "C:\Users\mmishal001\Desktop\Project PT Attempt 3\DEMO2 for VBA\Director 2\Manager 4")


    For Each folder_path In vFiles
        'specifying file types or extn.
        my_files = Dir(folder_path & "\*.xlsx")
        Do While my_files <> vbNullString
            Set wb = Workbooks.Open(folder_path & "\" & my_files)
            Set ws = wb.Sheets(1)

            ' This is the code to insert
            With ws
                .Cells.Locked = True
                .Range("A1:A10").Locked = False
                .Protect ""  'No password but protected.
            End With

            ws.Range("A1:A5").Value = "mahir"
            wb.Close True
            my_files = Dir()
        Loop
    Next folder_path
    MsgBox ("All files are updated")
End Sub
...