Notifikationer

Markér alle som læst Log ud

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??

Synes godt om

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

Synes godt om

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??

Synes godt om

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.

Synes godt om

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

Synes godt om

store-morten Ekspert

25. marts 2012 - 15:21 #5

http://www.youtube.com/watch?v=s26DGiuvXBo

Synes godt om

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.

Følg dette spørgsmål

Opret Preview

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
Finde mindsteværdi som er større end 00:00:00 Af Peder Lund Nielsen i Excel	6	20/10/202511:14	20/10/202518:52
HVIS + LOPSLAG til flere værdier Af SQF i Excel	4	09/10/202510:50	14/10/202516:09
Finde uger og dage mellem 2 datoer Af mefa i Excel	9	08/10/202519:21	10/10/202505:05
Excel Makroer programmering bit32 - bit64 Af bhh i Excel	3	01/10/202512:22	03/10/202513:32
Eliminer kendte Af andershl i Excel	1	30/09/202520:40	01/10/202512:54

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.

Du kan også logge ind via nedenstående tjenester

Alle kategorier på Eksperten

Seneste artiklerRSS