CIO Tech Eksperten IT-JOB IT-Kurser Events Podcast Søg

Log ind eller opret profil

Du kan også logge ind via nedenstående tjenester

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

Stort udvalg af Excel kurser til alle niveauer og jobfunktioner

Se alle Excel kurser

Flere spørgsmål fra Excel kategorien

Titel	Indlæg	Oprettet	Seneste aktivitet
Fortsæt i nyt lopslag ved fejl ved det første Af Roland i Excel	2	I går 12:58	I går 15:10
VBA Excel Af ingeman i Excel	17	12/02/202515:42	14/02/202511:44
Tjekke redigering af delt Excel fil Af cyperbent i Excel	3	06/02/202522:51	08/02/202518:16
Kæder til eksternt regneark Af mira96ac i Excel	5	05/02/202515:21	06/02/202511:41
Stablede søjlediagrammer Af Michel998 i Excel	1	05/02/202512:18	05/02/202512:33

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