Avatar billede petzel Novice
01. marts 2012 - 19:34 Der er 4 kommentarer og
1 løsning

Automatisk farvning af ark

Her er hved jeg ønsker.

Jeg skal ha en makro som farvegiver "ark fanen" efter hvilke tal der står i celle A1 i det aktuelle ark.

Der skal være 6 mulige farver
1=sort
2=rød
3=blå
4=grøn
5=gul
6=grå

Er det muligt??
Avatar billede store-morten Ekspert
01. marts 2012 - 20:32 #1
Sætter farven, når der ændres i celle A1
Koden lægges på det/de ark det skal virke på.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1")) Is Nothing Then
ArkKode = Target.Value
Select Case ArkKode
    Case 1
    ActiveSheet.Tab.ColorIndex = 1
    Case 2
    ActiveSheet.Tab.ColorIndex = 3
    Case 3
    ActiveSheet.Tab.ColorIndex = 5
    Case 4
    ActiveSheet.Tab.ColorIndex = 10
    Case 5
    ActiveSheet.Tab.ColorIndex = 6
    Case 6
    ActiveSheet.Tab.ColorIndex = 15
    Case Else
    ActiveSheet.Tab.ColorIndex = -4142
End Select
End If
End Sub
'Farvekoder til Interior.Colorindex
      '0        = Tom              1        = Sort
      '2        = Hvid              3        = Rød
      '4        = KnaldGrøn        5        = Blå
      '6        = Gul              7        = Pink
      '8        = Turkis            9        = Rødbrun
      '10        = Grøn            11        = Mørkeblå
      '12        = Olivengul        13        = Violet
      '14        = Blågrøn          15        = Grå 25%
      '16        = Grå 50%          17        = Støvet Blå
      '18        = Blomme          19        = Støvet Lys Gul
      '20        = Blegturkis      21        = Støvet Violet
      '22        = Støvet Lyserød
Avatar billede petzel Novice
02. marts 2012 - 17:18 #2
Super - DET VIRKER!!

Hvad nu hvis...

Jeg har en fil med 30 ark (aftale 1, aftale 2... aftale 30)
Dertil et ark"oversigt"

I arket "oversigt" overføres data fra de 30 ark, og i kolonne B står:
aftale 1
aftale 2
(alle sammen listet op ned efter med hyberlink)

I kolonne E angiver man ud for hver aftale dens status.. 1-5
Kan man få makroen til at finde den celle i kolonne B som stemmer overens med ark navnet og ud fra status dataen i kolonne E angive farven efter samme fremgangsmåde som før??
Avatar billede store-morten Ekspert
02. marts 2012 - 18:23 #3
Ark navn i: B1:B30
Status i:    E1:E30

Prøv, på oversigtsArk:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Arknavn
If Not Intersect(Target, Range("E1:E30")) Is Nothing Then
ArkKode = Target.Value
Arknavn = Target.Offset(0, -3).Value
Select Case ArkKode
    Case 1
    Sheets(Arknavn).Tab.ColorIndex = 1
    Case 2
    Sheets(Arknavn).Tab.ColorIndex = 3
    Case 3
    Sheets(Arknavn).Tab.ColorIndex = 5
    Case 4
    Sheets(Arknavn).Tab.ColorIndex = 10
    Case 5
    Sheets(Arknavn).Tab.ColorIndex = 6
    Case 6
    Sheets(Arknavn).Tab.ColorIndex = 15
    Case Else
    Sheets(Arknavn).Tab.ColorIndex = -4142
End Select
End If
End Sub
'Farvekoder til Interior.Colorindex
      '0        = Tom              1        = Sort
      '2        = Hvid              3        = Rød
      '4        = KnaldGrøn        5        = Blå
      '6        = Gul              7        = Pink
      '8        = Turkis            9        = Rødbrun
      '10        = Grøn            11        = Mørkeblå
      '12        = Olivengul        13        = Violet
      '14        = Blågrøn          15        = Grå 25%
      '16        = Grå 50%          17        = Støvet Blå
      '18        = Blomme          19        = Støvet Lys Gul
      '20        = Blegturkis      21        = Støvet Violet
      '22        = Støvet Lyserød


Der er stadig 1 - 6 mulige farver.
Case 6
    Sheets(Arknavn).Tab.ColorIndex = 15

Kan evt slettes.
Avatar billede store-morten Ekspert
02. marts 2012 - 20:01 #4
Med fejlbehandler, ved stave fejl eller Arkfane ikke findes:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ErrHandler:

Dim Arknavn
If Not Intersect(Target, Range("E1:E30")) Is Nothing Then
ArkKode = Target.Value
Arknavn = Target.Offset(0, -3).Value
Select Case ArkKode
    Case 1
    Sheets(Arknavn).Tab.ColorIndex = 1
    Case 2
    Sheets(Arknavn).Tab.ColorIndex = 3
    Case 3
    Sheets(Arknavn).Tab.ColorIndex = 5
    Case 4
    Sheets(Arknavn).Tab.ColorIndex = 10
    Case 5
    Sheets(Arknavn).Tab.ColorIndex = 6
    Case 6
    Sheets(Arknavn).Tab.ColorIndex = 15
    Case Else
    Sheets(Arknavn).Tab.ColorIndex = -4142
End Select
End If

ErrHandler:
    If Err.Number = 9 Then
    MsgBox "=-= Arket findes ikke! =-=" & vbCrLf & _
            " " & vbCrLf & _
            "Kontroller at Fane navnet er korrekt!" & vbCrLf & _
            " " & vbCrLf & _
            "Eller om Fane eksisterer?"
    Target.Offset(0, -3).Select
    End If

End Sub
'Farvekoder til Interior.Colorindex
      '0        = Tom              1        = Sort
      '2        = Hvid              3        = Rød
      '4        = KnaldGrøn        5        = Blå
      '6        = Gul              7        = Pink
      '8        = Turkis            9        = Rødbrun
      '10        = Grøn            11        = Mørkeblå
      '12        = Olivengul        13        = Violet
      '14        = Blågrøn          15        = Grå 25%
      '16        = Grå 50%          17        = Støvet Blå
      '18        = Blomme          19        = Støvet Lys Gul
      '20        = Blegturkis      21        = Støvet Violet
      '22        = Støvet Lyserød
Avatar billede store-morten Ekspert
25. marts 2012 - 15:21 #5
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Vi har et stort udvalg af Excel kurser. Find lige det kursus der passer dig lige her.

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester