Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Пароль, Пароль VBA
 
#1
12.02.2020 08:36:52
Доброго дня всем гуру Excel и VBA!
В наследство досталась полезная книга с кучей макросов.
Проблема заключается в том, что зная пароль от листов невозможно сбросить его. Снимая пароли и сохраняя книгу, далее открыв ее заново там вновь стоят те же самые пароли. Не может ли в коде стоять автообновление паролей листов?
Код
Sub unpaidd()
    rasp = Application.ActiveWorkbook.Name
    listok = Application.ActiveSheet.Name
    With Workbooks(rasp)
        .Activate
        With .Sheets(listok)
            o = Application.WorksheetFunction.Sum(.Range("A2:AG2"))
            If o > 0 Then
                unp = Workbooks(rasp).Sheets("STAT").Cells(2, 99).Value
                unpr = Workbooks(rasp).Sheets("STAT").Cells(3, 99).Value
                rc1 = Workbooks(rasp).Sheets("STAT").Cells(6, 75).Value
                rc2 = Workbooks(rasp).Sheets("STAT").Cells(7, 75).Value
                r1 = Workbooks(rasp).Sheets("STAT").Cells(3, 73).Value
                r2 = Workbooks(rasp).Sheets("STAT").Cells(4, 73).Value
                r3 = Workbooks(rasp).Sheets("STAT").Cells(5, 73).Value
                r4 = Workbooks(rasp).Sheets("STAT").Cells(6, 73).Value
                r5 = Workbooks(rasp).Sheets("STAT").Cells(7, 73).Value
                r6 = Workbooks(rasp).Sheets("STAT").Cells(8, 73).Value
                s3 = Workbooks(rasp).Sheets("STAT").Cells(4, 76).Value
                yo = Application.WorksheetFunction.CountA(.Range("" & s3 & "" & r1 & ":" & s3 & "" & r2 & ""))
                yi = Application.WorksheetFunction.CountA(.Range("" & s3 & "" & r3 & ":" & s3 & "" & r4 & ""))
                yt = Application.WorksheetFunction.CountA(.Range("" & s3 & "" & r4 & ":" & s3 & "" & r6 & ""))
                q = rc1
                Do While q <= rc2
                    If o > 0 Then
                        If .Cells(2, q).Value = 1 Then
                            If yo > 0 Then
                                .Range(Cells(r1, q), Cells(r1 + yo - 1, q)).Value = unp
                            End If
                            If yi > 0 Then
                                .Range(Cells(r3, q), Cells(r3 + yi - 1, q)).Value = unp
                            End If
                            If yt > 0 Then
                                .Range(Cells(r5, q), Cells(r5 + yt - 1, q)).Value = unp
                            End If
                            o = o - 1
                        End If
                        If .Cells(2, q).Value = 2 Then
                            If yo > 0 Then
                                .Range(Cells(r1, q), Cells(r1 + yo - 1, q)).Value = unpr
                            End If
                            If yi > 0 Then
                                .Range(Cells(r3, q), Cells(r3 + yi - 1, q)).Value = unpr
                            End If
                            If yt > 0 Then
                                .Range(Cells(r5, q), Cells(r5 + yt - 1, q)).Value = unpr
                            End If
                            o = o - 2
                        End If
                    Else
                        q = rc2
                    End If
                    q = q + 1
                Loop
            End If
        End With
    End With
End Sub
Sub unpaidn()
    rasp = Application.ActiveWorkbook.Name
    listok = Application.ActiveSheet.Name
    With Workbooks(rasp)
        .Activate
        With .Sheets(listok)
            o = Application.WorksheetFunction.Sum(.Range("AP2:BO2"))
            If o > 0 Then
                unp = Workbooks(rasp).Sheets("STAT").Cells(2, 99).Value
                unpr = Workbooks(rasp).Sheets("STAT").Cells(3, 99).Value
                rc3 = Workbooks(rasp).Sheets("STAT").Cells(8, 75).Value
                rc4 = Workbooks(rasp).Sheets("STAT").Cells(9, 75).Value
                r1 = Workbooks(rasp).Sheets("STAT").Cells(3, 73).Value
                r2 = Workbooks(rasp).Sheets("STAT").Cells(4, 73).Value
                r3 = Workbooks(rasp).Sheets("STAT").Cells(5, 73).Value
                r4 = Workbooks(rasp).Sheets("STAT").Cells(6, 73).Value
                r5 = Workbooks(rasp).Sheets("STAT").Cells(7, 73).Value
                r6 = Workbooks(rasp).Sheets("STAT").Cells(8, 73).Value
                s4 = Workbooks(rasp).Sheets("STAT").Cells(5, 76).Value
                xo = Application.WorksheetFunction.CountA(.Range("" & s4 & "" & r1 & ":" & s4 & "" & r2 & ""))
                q = rc3
                Do While q <= rc4
                    If o > 0 Then
                        If .Cells(2, q).Value = 1 Then
                            If xo > 0 Then
                                .Range(Cells(r1, q), Cells(r1 + xo - 1, q)).Value = unp
                            End If
                            o = o - 1
                        End If
                        If .Cells(2, q).Value = 2 Then
                            If xo > 0 Then
                                .Range(Cells(r1, q), Cells(r1 + xo - 1, q)).Value = unpr
                            End If
                            o = o - 2
                        End If
                    Else
                        q = rc4
                    End If
                    q = q + 1
                Loop
            End If
        End With
    End With
End Sub
Sub fild()
    rasp = Application.ActiveWorkbook.Name
    listok = Application.ActiveSheet.Name
    With Workbooks(rasp)
        .Activate
        With .Sheets(listok)
            rc1 = Workbooks(rasp).Sheets("STAT").Cells(6, 75).Value
            rc2 = Workbooks(rasp).Sheets("STAT").Cells(7, 75).Value
            c1 = Workbooks(rasp).Sheets("STAT").Cells(6, 76).Value
            c2 = Workbooks(rasp).Sheets("STAT").Cells(7, 76).Value
            r1 = Workbooks(rasp).Sheets("STAT").Cells(3, 73).Value
            r2 = Workbooks(rasp).Sheets("STAT").Cells(4, 73).Value
            r3 = Workbooks(rasp).Sheets("STAT").Cells(5, 73).Value
            r4 = Workbooks(rasp).Sheets("STAT").Cells(6, 73).Value
            r5 = Workbooks(rasp).Sheets("STAT").Cells(7, 73).Value
            r6 = Workbooks(rasp).Sheets("STAT").Cells(8, 73).Value
            s1 = Workbooks(rasp).Sheets("STAT").Cells(4, 75).Value
            p1 = Workbooks(rasp).Sheets("STAT").Cells(2, 75).Value
            p3 = Workbooks(rasp).Sheets("STAT").Cells(2, 76).Value
            ss1 = Workbooks(rasp).Sheets("STAT").Cells(12, 76).Value
            sd = Workbooks(rasp).Sheets("STAT").Cells(10, 99).Value
            yo = Application.WorksheetFunction.CountA(.Range("" & p3 & "" & r1 & ":" & p3 & "" & r2 & ""))
            yi = Application.WorksheetFunction.CountA(.Range("" & p3 & "" & r3 & ":" & p3 & "" & r4 & ""))
            yt = Application.WorksheetFunction.CountA(.Range("" & p3 & "" & r5 & ":" & p3 & "" & r6 & ""))
            If yo > 0 Then
                q = r1
                Do While q <= r1 + yo - 1
                    If .Cells(q, p1).Value <> "" Then
                        Z = Application.WorksheetFunction.Match(.Range("" & p3 & "" & q & "").Value, Workbooks(rasp).Sheets("STAT").Range("CK1:CK40"), 0)
                        .Cells(q, s1).Value = Workbooks(rasp).Sheets("STAT").Range("CL" & Z).Value
                        .Range("" & c1 & "" & q & ":" & c2 & "" & q & "").Value = .Cells(q, s1).Value
                        If .Range("" & ss1 & "" & q & "").Value = "" Then
                            .Range("" & ss1 & "" & q & "").Value = sd
                        End If
                    End If
                    q = q + 1
                Loop
            End If
            If yi > 0 Then
                q = r3
                Do While q <= r3 + yi - 1
                    If .Cells(q, p1).Value <> "" Then
                         Z = Application.WorksheetFunction.Match(.Range("" & p3 & "" & q & ""), Workbooks(rasp).Sheets("STAT").Range("CN1:CN40"), 0)
                        .Cells(q, s1).Value = Workbooks(rasp).Sheets("STAT").Range("CO" & Z).Value
                        .Range("" & c1 & "" & q & ":" & c2 & "" & q & "").Value = .Cells(q, s1).Value
                        If .Range("" & ss1 & "" & q & "").Value = "" Then
                            .Range("" & ss1 & "" & q & "").Value = sd
                        End If
                    End If
                    q = q + 1
                Loop
            End If
            If yt > 0 Then
                q = r5
                Do While q <= r5 + yt - 1
                    If .Cells(q, p1).Value <> "" Then
                         Z = Application.WorksheetFunction.Match(.Range("" & p3 & "" & q & ""), Workbooks(rasp).Sheets("STAT").Range("CQ1:CQ40"), 0)
                        .Cells(q, s1).Value = Workbooks(rasp).Sheets("STAT").Range("CR" & Z).Value
                        .Range("" & c1 & "" & q & ":" & c2 & "" & q & "").Value = .Cells(q, s1).Value
                        If .Range("" & ss1 & "" & q & "").Value = "" Then
                            .Range("" & ss1 & "" & q & "").Value = sd
                        End If
                    End If
                    q = q + 1
                Loop
            End If
        End With
    End With
End Sub
Sub filn()
    rasp = Application.ActiveWorkbook.Name
    listok = Application.ActiveSheet.Name
    With Workbooks(rasp)
        .Activate
        With .Sheets(listok)
            rc3 = Workbooks(rasp).Sheets("STAT").Cells(8, 75).Value
            rc4 = Workbooks(rasp).Sheets("STAT").Cells(9, 75).Value
            c3 = Workbooks(rasp).Sheets("STAT").Cells(8, 76).Value
            c4 = Workbooks(rasp).Sheets("STAT").Cells(9, 76).Value
            r1 = Workbooks(rasp).Sheets("STAT").Cells(3, 73).Value
            r2 = Workbooks(rasp).Sheets("STAT").Cells(4, 73).Value
            r3 = Workbooks(rasp).Sheets("STAT").Cells(5, 73).Value
            r4 = Workbooks(rasp).Sheets("STAT").Cells(6, 73).Value
            r5 = Workbooks(rasp).Sheets("STAT").Cells(7, 73).Value
            r6 = Workbooks(rasp).Sheets("STAT").Cells(8, 73).Value
            s2 = Workbooks(rasp).Sheets("STAT").Cells(5, 75).Value
            p2 = Workbooks(rasp).Sheets("STAT").Cells(3, 75).Value
            p4 = Workbooks(rasp).Sheets("STAT").Cells(3, 76).Value
            ss2 = Workbooks(rasp).Sheets("STAT").Cells(13, 76).Value
            sd = Workbooks(rasp).Sheets("STAT").Cells(10, 99).Value
            xo = Application.WorksheetFunction.CountA(.Range("" & p4 & "" & r1 & ":" & p4 & "" & r2 & ""))
            xi = Application.WorksheetFunction.CountA(.Range("" & p4 & "" & r3 & ":" & p4 & "" & r4 & ""))
            xt = Application.WorksheetFunction.CountA(.Range("" & p4 & "" & r5 & ":" & p4 & "" & r6 & ""))
            If xo > 0 Then
                q = r1
                Do While q <= r1 + xo - 1
                    If .Cells(q, p2).Value <> "" Then
                        Z = Application.WorksheetFunction.Match(.Range("" & p4 & "" & q & ""), Workbooks(rasp).Sheets("STAT").Range("CK1:CK40"), 0)
                        .Cells(q, s2).Value = Workbooks(rasp).Sheets("STAT").Range("CL" & Z).Value
                        .Range("" & c3 & "" & q & ":" & c4 & "" & q & "").Value = .Cells(q, s2).Value
                        If .Range("" & ss2 & "" & q & "").Value = "" Then
                            .Range("" & ss2 & "" & q & "").Value = sd
                        End If
                    End If
                    q = q + 1
                Loop
            End If
            If xi > 0 Then
                q = r3
                Do While q <= r3 + xi - 1
                    If .Cells(q, p2).Value <> "" Then
                        Z = Application.WorksheetFunction.Match(.Range("" & p4 & "" & q & ""), Workbooks(rasp).Sheets("STAT").Range("CN1:CN40"), 0)
                        .Cells(q, s2).Value = Workbooks(rasp).Sheets("STAT").Range("CO" & Z).Value
                        .Range("" & c3 & "" & q & ":" & c4 & "" & q & "").Value = .Cells(q, s2).Value
                        If .Range("" & ss2 & "" & q & "").Value = "" Then
                            .Range("" & ss2 & "" & q & "").Value = sd
                        End If
                    End If
                    q = q + 1
                Loop
            End If
            If xt > 0 Then
                q = r5
                Do While q <= r5 + xt - 1
                    If .Cells(q, p2).Value <> "" Then
                        Z = Application.WorksheetFunction.Match(.Range("" & p4 & "" & q & ""), Workbooks(rasp).Sheets("STAT").Range("CQ1:CQ40"), 0)
                        .Cells(q, s2).Value = Workbooks(rasp).Sheets("STAT").Range("CR" & Z).Value
                        .Range("" & c3 & "" & q & ":" & c4 & "" & q & "").Value = .Cells(q, s2).Value
                        If .Range("" & ss2 & "" & q & "").Value = "" Then
                            .Range("" & ss2 & "" & q & "").Value = sd
                        End If
                    End If
                    q = q + 1
                Loop
            End If
        End With
    End With
End Sub
Sub cvet()
    rasp = Application.ActiveWorkbook.Name
    listok = Application.ActiveSheet.Name
    With Workbooks(rasp)
        .Activate
        codd = Workbooks(rasp).Sheets("INDEX").Cells(2, 109).Value
        Workbooks(rasp).Sheets(listok).Unprotect codd
        With .Sheets(listok)
            Cells.Select
            Selection.FormatConditions.Delete
            r1 = Workbooks(rasp).Sheets("STAT").Cells(2, 86).Value
            r2 = Workbooks(rasp).Sheets("STAT").Cells(2, 87).Value
            c1 = Workbooks(rasp).Sheets("STAT").Cells(4, 76).Value
            c2 = Workbooks(rasp).Sheets("STAT").Cells(9, 76).Value
            y = Application.WorksheetFunction.CountA(Workbooks(rasp).Sheets("STAT").Range("CH:CH")) - 1
            q = 2
            .Range("" & c1 & "" & r1 & ":" & c2 & "" & r2 & "").Select
            Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=ISERROR(A6)"
            Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
            With Selection.FormatConditions(1).Interior
                .PatternColorIndex = xlAutomatic
                .Color = 255
                .TintAndShade = 0
            End With
            Selection.FormatConditions(1).StopIfTrue = False
            Do While q <= 1 + y
                x = Workbooks(rasp).Sheets("STAT").Cells(q, 85).Interior.Color
                If Workbooks(rasp).Sheets("STAT").Cells(q, 85).Value = Workbooks(rasp).Sheets("STAT").Cells(2, 99).Value Then
                    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=STAT!$CG$" & q & ""
                    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
                    With Selection.FormatConditions(1).Font
                        .Bold = True
                        .Italic = False
                        .ThemeColor = xlThemeColorDark1
                        .TintAndShade = 0
                    End With
                    With Selection.FormatConditions(1).Interior
                        .PatternColorIndex = xlAutomatic
                        .Color = x
                        .TintAndShade = 0
                    End With
                    Selection.FormatConditions(1).StopIfTrue = False
                Else
                    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="=STAT!$CG$" & q & ""
                    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
                    With Selection.FormatConditions(1).Interior
                        .PatternColorIndex = xlAutomatic
                        .Color = x
                        .TintAndShade = 0
                    End With
                    Selection.FormatConditions(1).StopIfTrue = False
                End If
                q = q + 1
            Loop
            .Cells(1, 1).Select
        End With
        Workbooks(rasp).Sheets(listok).Protect Password:=codd, DrawingObjects:=False, Contents:=True, Scenarios:=True, UserInterfaceOnly:=True
    End With
End Sub
Sub allpressday()
    Call fild
    Call unpaidd
    Call cvet
End Sub
Sub allpressnight()
    Call filn
    Call unpaidn
    Call cvet
End Sub
Самостоятельно я не нашел в данном коде что то связанное с паролями
 
 
 
#2
12.02.2020 08:40:21
Может и стоит:
Код
Workbooks(rasp).Sheets(listok).Protect Password:=codd
 
 
 
#3
12.02.2020 08:40:47
Chin_Chin, думаю к названию темы возникнут вопросы
Изменено: Polkilo - 12.02.2020 08:41:44
 
 
 
#4
12.02.2020 08:41:56
Весьма информативное название темы  :D
"Все гениальное просто, а все простое гениально!!!"
 
 
 
#5
12.02.2020 08:46:09
Цитата
Андрей_26 написал:
Workbooks(rasp).Sheets(listok).Protect Password:=codd
С названием конечно я намудрил..
нет, в этой ячейке нет кода к листам.
 
 
 
#6
12.02.2020 08:47:37
Chin_Chin, Пароль НЕ на листе listok, название темы предложите)
 
 
 
#7
12.02.2020 08:52:57
Цитата
Polkilo написал:
Пароль НЕ на листе listok, название темы предложите
Не понял на счет темы.
Пароль Sheets("INDEX").Cells(2, 109)?
 
 
 
#8
12.02.2020 09:12:43
Chin_Chin, представьте, Вы приходите на форум по SQL с вопросом как указать поля в запросе. А там Over9000 тем с названиями Select, Проблема с Select, Ошибка в Select.
Как быстро Вы сможете найти нужную Вам информацию?

Облегчите поиск тем, кто зайдёт на форум после Вас. Предложите более конкретное название темы.
"После работы макроса устанавливается пароль на лист", например.

Да, пароль на листе INDEX
Изменено: Polkilo - 12.02.2020 09:13:06
 
 
 
#9
12.02.2020 09:34:37
Понял Вас, в следующий раз учту это. Да, пароль нашел и все убрал. Большое спасибо за помощь!
 
 
 
#10
12.02.2020 10:52:37
Правильно, пусть теперь помощники отдуваются
 
 
 
Страницы: 1
Наверх