Søg
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
http://www.youtube.com/watch?v=s26DGiuvXBo
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
Excel kurser
Excel kurser for alle niveauer og behov – find det kursus, der passer til dig
Se alle Excel kurser

Flere spørgsmål fra Excel kategorien

Titel Indlæg Oprettet Seneste aktivitet
Hvordan bruges indeks & sammenlign når der skal søges over flere kolonner? Af Laugesen1 i Excel 4 08/03/202611:56 08/03/202613:57
Tips til at mestre Excel hurtigt Af MonikaG32 i Excel 4 04/03/202617:11 06/03/202609:37
Båndet i Excel online har ændret størrelse Af Monique i Excel 3 19/02/202614:23 20/02/202608:26
Fjern tekst efter mellemrum Af ABE15 i Excel 2 18/02/202620:41 19/02/202611:30
Udskrift af ark Af boro23 i Excel 4 17/02/202608:38 18/02/202607:46
Se alle spørgsmål i kategorien Opret spørgsmål

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.

Opret Log ind

Du kan også logge ind via nedenstående tjenester

Alle kategorier på Eksperten
Seneste spørgsmål Seneste aktivitet
I dag 00:56 3 skærme 27 Af bbm i Skærme
I går 16:18 "gratis" "reklamefri" hjemmeside -næsten --som man kan lave i søvne : Af Novice-1 i Andet software
19/0316:52 Proxy router/server Af joki i Routere & Switches
19/0311:04 Icotera vs Nokia fiberboks Af Uvanga i Routere & Switches
18/0323:30 Outlook send/modtag manuelt Af pwn i Office & Kontorpakker
White papers
Flere white papers »