sss = Left(Dir(file, vbNormal), 6)
    ActiveWorkbook.Unprotect (Password = sss)
    Range("F11").Select
    ActiveSheet.Paste
    ActiveWorkbook.Protect Password = (Left(Dir(file, vbNormal), 6)), UserInterfaceOnly = True
    ActiveWorkbook.Save
    ActiveWorkbook.Close

Sub OpenF()
Dim a As String 'путь к родительской папке
Dim b As String 'путь к папке, где находится файл
Dim c As String 'имя файла, который нужно открыть
Dim dt as string
 
a = Sheets("Адрес").Range("B1") 'указываем значение переменной а, которое является путем к родительской папке
b = Sheets("Адрес").Range("B2") 'указываем значение переменной b, которое является путем к папке, где находится файл
c = Sheets("Адрес").Range("B3") 'указываем значение переменной c, которое является названием файла

dt = format(Now(), "mmm")
dt = switch( dt = "Январь", "ЯНВ", dt = "Февраль", "ФЕВ" и т.п. и т.д.)
 
Application.Workbooks.Open a & b & c 'открываем файл
Sheets(dt).Activate
 
End Sub

dim dt as string
dt = format(Now(), "mmm")

dt = switch( dt = "Январь", "ЯНВ", dt = "Февраль", "ФЕВ" и т.п. и т.д.)

Private Sub UserForm_Initialize()
With task_list
.ColumnCount = 7
.ColumnHeads = True
End With
    Application.ScreenUpdating = False
    cb_uncomp = True
    Dim D, sh, y As Boolean
    For Each sh In Sheets
       If sh.Name = "_список заданий" Then y = True: Exit For
    Next
    If y = True Then
        Application.DisplayAlerts = False
        Sheets("_список заданий").Delete
    End If
    Call create_task_list
End Sub

Sub create_task_list()
'糺・・褪・ ・・ ・・task_manage_form
Dim task_bd As String
    Dim posinstr_f As Long
    Dim posinstr_l As Long
    Dim str_ln As Long
    Dim task_par() As String
    Dim mypath As String
    Dim task_list_h As Long
    
    
    Worksheets.Add
    ActiveSheet.Name = "_頌鶴 鈞萵湜・
    Cells(1, 1) = "ﾍ黑褞"
    Cells(1, 2) = "ﾑ鰀萵・
    Cells(1, 3) = "PLU"
    Cells(1, 4) = "ﾑ鶴"
    Cells(1, 5) = "ﾑ鰀萵・
    Cells(1, 6) = "ﾍ珸浯濵"
    Cells(1, 7) = "ﾑ・
    i = 1
    If task_manage_form.cb_uncomp = True Then
    mypath = "C:\Users\User\Documents\vba\task_bd\uncompleted\"
    Filename = Dir(mypath, vbNormal)
    ReDim task_par(6, i)
    Do While Filename <> ""
        If Filename <> "." And Filename <> ".." Then
            ReDim Preserve task_par(6, i)
            posinstr_f = 1
            posinstr_l = 1
                For Z = 1 To 6
                posinstr_l = InStr(posinstr_f, Filename, "&")
                If posinstr_l = 0 Then
                posinstr_l = Len(Filename) - 3
                End If
                str_ln = (posinstr_l - posinstr_f)
                Cells(i + 1, Z) = Mid(Filename, posinstr_f, str_ln)
                task_par(Z, i) = Mid(Filename, posinstr_f, str_ln)
                posinstr_f = posinstr_l + 1
                Next Z
            Cells(i + 1, 7) = "淲 鈞粢褊・
            Cells(i + 1, 8) = mypath & Filename
            i = i + 1
        End If
        Filename = Dir
    Loop
    If Cells(2, 1) <> "" Then
    End If
    End If
    If task_manage_form.cb_comp = True Then
    mypath = "C:\Users\User\Documents\vba\task_bd\completed\"
    Filename = Dir(mypath, vbNormal)
    ReDim task_par(6, i)
    Do While Filename <> ""
        If Filename <> "." And Filename <> ".." Then
            ReDim Preserve task_par(6, i)
            posinstr_f = 1
            posinstr_l = 1
                For Z = 1 To 6
                posinstr_l = InStr(posinstr_f, Filename, "&")
                If posinstr_l = 0 Then
                posinstr_l = Len(Filename) - 3
                End If
                str_ln = (posinstr_l - posinstr_f)
                Cells(i + 1, Z) = Mid(Filename, posinstr_f, str_ln)
                task_par(Z, i) = Mid(Filename, posinstr_f, str_ln)
                posinstr_f = posinstr_l + 1
                Next Z
            Cells(i + 1, 7) = "鈞粢褊・
            Cells(i + 1, 8) = mypath & Filename
            i = i + 1
        End If
        Filename = Dir
    Loop

    End If
    
    If Cells(2, 1) <> "" Then
    If Cells(3, 1) <> "" Then
    task_list_h = Range(Cells(2, 1), Cells(2, 1).End(xlDown)).Count
    Else
    task_list_h = 1
    End If
    End If


With task_manage_form.task_list
If task_manage_form.cb_comp = True Or task_manage_form.cb_uncomp = True Then
.RowSource = "A2:G" & (task_list_h + 1)
Else
.RowSource = "A2:G2"
End If
End With
Exit Sub
End Sub