Makro og VBA - Protect - Tillad baggrundsfarve ændres på celler

Protect - Tillad baggrundsfarve ændres på celler

Udskrevet fra: Dansk Regneark Forum
Kategori: Hjælp til regneark.
Forum navn: Makro og VBA
Forum beskrivelse: Hjælp til Makroer og VBA-programmering
Web-adresse: https://forum.excel-regneark.dk/forum_posts.asp?TID=3764
Udskrevet den: 28.Apr.2024 kl. 12:25

Emne: Protect - Tillad baggrundsfarve ændres på celler

Besked fra: Ib Hansen
Emne: Protect - Tillad baggrundsfarve ændres på celler
Posteringsdato: 24.Jan.2019 kl. 13:43

Hej Forum.

Jeg fandt en kode på nettet, der tillader en baggrundsfarve ændres på en celle på OnFocus.

Og når den er OffFocus, ændres farven tilbage til Previous.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)    Static oPrev As Range
    
    On Error Resume Next
    oPrev.FormatConditions.Delete
    Target.FormatConditions.Add(Type:=xlExpression, Formula1:=True).Interior.Color = vbYellow
    Set oPrev = Target
End Sub

Men det virker kun, når fanen er ubeskyttet.

For at det skal virke når fanen er beskyttet, skal der tilføjes en settings til Beskyttelses-koden - Her nedenunder med rødt.
Ps. Jeg har et fast Password stående i Sheets("ArkIndstil").Range("Q1"), der kan ændres via en Userform.

    myPassword = Sheets("ArkIndstil").Range("Q1").Value    Sheets("Forside").Protect Password:=myPassword, AllowFormattingCells:=True

Desværre låser det også samtidigt al formattering af cellen op OnFocus og det må den ikke Cry

Jeg har prøvet, om jeg kan tilføje lnterior.Color til koden, men det kan jeg ikke få til at virke.

Faktisk må cellen slet ikke kunne formatteres på nogle måder.
Baggrundsfarven skal bare skifte OnFocus og tilbage igen OffFocus.

Er der en eller anden, der har en god ide ?

Mvh.

Ib

Ps igen - Jeg vil også lave en Settings, hvor man kan slå baggrundsfarven Til og Fra.
If Userform.CheckBox = True Then - osv.

-------------
Excel 2010 Dk og 2019 Dk på samme computer.
Bruger dog stadig mest 2010..
Men sådan er der jo så majet :o)

Svar:

Besked fra: Søren
Posteringsdato: 24.Jan.2019 kl. 16:10

Hej Ib
Prøv at optage hele forløbet.
Det løser oftest udfordringerne.
VH
Søren

Besked fra: Ib Hansen
Posteringsdato: 24.Jan.2019 kl. 16:17

Hej Søren.

Jeg forstår ikke helt, hvad du mener ?

Mvh.

-------------
Excel 2010 Dk og 2019 Dk på samme computer.
Bruger dog stadig mest 2010..
Men sådan er der jo så majet :o)

Besked fra: Ib Hansen
Posteringsdato: 24.Jan.2019 kl. 17:19

Hej igen Søren.

Du gav mig faktisk en god ide og den ser ud til at virke.

Jeg har en fane, hvor der er en masse forskellige indstillinger.

Og her har jeg en masse forskellige celler, hvor den sætter en værdi, hvis jeg indstiller et eller andet.

Jeg kalder værdierne "Kontakter" eller "Triggere" og de er rare at have.

F.eks.

- Når jeg kører koden, der beskytter arket, sætter den værdien "Ja" i en celle.

- Når jeg fjerne arkbeskyttelsen, sætter den værdien"Nej" i samme celle.

På den måde kan jeg styre, hvordan arket skal opføre sig med en IF - THEN - ELSE.

Jeg fandt koden, der kunne vise en baggrundsfarve i en celle, når man stillede sig i den.

Og gå tilbage til den oprindelige baggrundsfarve, når man forlod cellen igen.

Nu skulle jeg så bare finde en kode, der deaktiverede popup ved højreklik på en celle og den fandt jeg også.

- Koderne nedenunder indsættes på den fane, man ønsker den skal virke på - F.eks. Ark1.

- Hvis de skal virke på hele arket og ikke kun på en fane, indsættes de i ThisWorkbook.

Når jeg tjekker CheckBoxen i arket Settings af, at den skal vise baggrundsfarve, skriver den "Ja" i Sheets("ArkIndstil").Range("Q15").
Ellers skriver den "Nej" i samme celle.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)'-------------------'
' Cellefarve Ja/Nej '
'-------------------'
    Static oPrev As Range
    
    If Sheets("ArkIndstil").Range("Q15") = "Nej" Then
        Exit Sub
    Else
        On Error Resume Next
        oPrev.FormatConditions.Delete
        Target.FormatConditions.Add(Type:=xlExpression, Formula1:=True).Interior.Color = vbYellow
        Set oPrev = Target
    End If
End Sub

Når jeg beskytter arket skriver den "Ja" i Sheets("ArkIndstil").Range("Q16").

Ellers skriver den "Nej" i samme celle.

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)'----------------------------'
' Popup ved højreklik Ja/Nej '
'----------------------------'
    If Sheets("ArkIndstil").Range("Q16") = "Ja" Then
        Cancel = True
    Else
        Cancel = False
    End If
End Sub

Mvh.

-------------
Excel 2010 Dk og 2019 Dk på samme computer.
Bruger dog stadig mest 2010..
Men sådan er der jo så majet :o)