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
Måned og år på graf Af mort1 i Excel 4 31/10/202613:01 01/11/202614:13
VB, Lægge 2 celler sammen og skrive den i cellen ved side af Af MC3390 i Excel 9 23/09/202618:11 24/09/202611:16
Ændre tal i en celle Af xvid i Excel 1 04/09/202616:05 04/09/202616:54
Kan Excel selv beregne alder? Af leahcim i Excel 7 31/08/202610:24 04/09/202602:08
problem med mailbesked Af Pestilensen i Excel 3 24/08/202611:16 28/08/202612:55
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 går 16:24 Google driller på MS Edge Af ErikHg i Browsere
I går 15:48 søger pris på en bærbar Af dcedata1977 i PC
06/1119:03 iMac 2026 M6 10-core GPU (standart ell opdatering) Af LLG i Mac
06/1109:43 Vista Af susej14 i Andet software
05/1111:47 Printernavn i Enhedshåndtering er et andet end i Printere og Scannere Af Uvanga i Printere
White papers
Flere white papers »