Print side | Luk vindue

Script virker kun en gang

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=314
Udskrevet den: 24.Maj.2024 kl. 23:58


Emne: Script virker kun en gang
Besked fra: tingen
Emne: Script virker kun en gang
Posteringsdato: 07.Apr.2011 kl. 15:47
Dette script virker kun første gang det bliver kørt, er der nogen der har samme problem, eller evt. har en løsning?

Nogle tilføjelser?

Kode:


Sub color()
    Dim icolor As Integer
    Dim myDate As Date
    Dim Font_Color As Integer
        
   
    Dim rng As Range, c As Range
    Set rng = Range("N14:BM74")
    For Each c In rng.Cells
   
        Select Case c

        Case "x"
            icolor = 2
           
        Case "a"
            icolor = 35

        Case "b"
            icolor = 43

        Case "c"
            icolor = 38

        Case "d"
            icolor = 39

        Case "e"
            icolor = 10

        Case "g"
            icolor = 9

        Case "h"
            icolor = 6

        Case "i"
            icolor = 46

        Case "j"
            icolor = 3

        Case "k"
            icolor = 20

        Case "l"
            icolor = 41

        Case "m"
            icolor = 25
           
        Case "o"
            icolor = 8
           
        Case Else
            icolor = 0
           
    End Select
   
    c.Font.ColorIndex = icolor
    c.Interior.ColorIndex = icolor
          
Next c
           

Dim rng2 As Range, x As Range
Set rng2 = Range("A14:M74")
For Each x In rng2.Cells

    Select Case x


        Case "Daglige opgaver"
            lol = xlCenter
            xcolor = 15
            bfont = True
               
        Case "Ugentlige opgaver"
            lol = xlCenter
            xcolor = 15
            bfont = True
               
        Case "Månedlige opgaver"
            lol = xlCenter
            xcolor = 15
            bfont = True
               
        Case "Løbende opgaver"
            lol = xlCenter
            xcolor = 15
            bfont = True

        Case "1. Prioritet"
            lol = xlCenter
            xcolor = 15
            bfont = True
               
        Case "2. Prioritet"
            lol = xlCenter
            xcolor = 15
            bfont = True
               
        Case "3. Prioritet"
            lol = xlCenter
            xcolor = 15
            bfont = True
               
        Case "4. Prioritet"
            lol = xlCenter
            xcolor = 15
            bfont = True
           
        Case "ÆLDRE SAGER"
            lol = xlCenter
            xcolor = 15
            bfont = True
               
        Case "SIDEN SIDSTE RAPPORTERING"
            lol = xlCenter
            xcolor = 15
            bfont = True
           
        Case "PLANLÆGNING TIL NÆSTE GANG"
            lol = xlCenter
            xcolor = 15
            bfont = True
           
        Case "Ferie/Fravær/Sygdom"
            lol = xlCenter
            xcolor = 15
            bfont = True
           
        Case Else
            xcolor = 0
            lol = xlLeft
            bfont = False
       
        End Select

        x.Interior.ColorIndex = xcolor
        x.Font.Bold = bfont
        x.HorizontalAlignment = lol
        x.Font.ColorIndex = 1
       
    Next x
   
   
        ActiveSheet.Protect


End Sub






Tak


Svar:
Besked fra: rassten
Posteringsdato: 07.Apr.2011 kl. 18:14
Prøv at skrive :
ActiveSheet.Unprotect

i toppen af kode og kør den igen


-------------
VH rassten

Arbejde excel 2010
Privat excel 2010

Besked fra: tingen
Posteringsdato: 11.Apr.2011 kl. 08:35
Det hjalp.. mange tak :)
men hvad gør den command?

Besked fra: rassten
Posteringsdato: 11.Apr.2011 kl. 12:02
Det sidste du gør i din oprindelige kode er at låse arket. '
Så den nye linie låse bare arket op før resten af koden køre (som jo så låser arket igen)


-------------
VH rassten

Arbejde excel 2010
Privat excel 2010


Print side | Luk vindue