Gruppen
- Top Gruppen
- Betriebsysteme
- Windows classik
- Linux
- BS-Sonstige
- Software
- Datenbanken
- Bildbearbeitung
- Audio/mp3/Video
- Security/Viren
- SW-Sonstige
- Hardware
- Mainboard/CPU
- Grafikkarten
- Peripherie
- Laptop/Notebook
- HW-Sonstiges
- Netzwerk
- Telefon,ISDN,Modem
- W-Lan
- NW-Sonstiges
- Programmierung
- PHP,ASP,Perl...
- Java,C++...
- Webseiten/HTML
- Sonstiges
- PC-Sonstiges
- Plauderecke
- SN Intern
- Test
/ Forum / Tabellenkalkulation
Tabellenkalkulation
Fragevon $KGB$ vom 08.01.2019, 13:23 Options
Quelcode in ein macro einbinden
Hallo Profis
kann mir bitte einer diesen Code so verändern das ich den einfach als Makro in ein Button einfügen kann.
Private Sub Worksheet_Change( _
ByVal Target As Excel.Range)
If Intersect(Target, Range("C5:C21")) _
Is Nothing Then Exit Sub
If Target.Value = "Test" Then
Target.Interior.ColorIndex = 4
Target.Font.ColorIndex = 1
End If
If Target.Value = "%" Then
Target.Interior.ColorIndex = 54
Target.Font.ColorIndex = 1
End If
If Target.Value = "K" Then
Target.Interior.ColorIndex = 10
Target.Font.ColorIndex = 1
End If
If Target.Value = "2" Then
Target.Interior.ColorIndex = 27
Target.Font.ColorIndex = 1
End If
If Target.Value = "3" Then
Target.Interior.ColorIndex = 14
Target.Font.ColorIndex = 1
End If
If Target.Value = "A" Then
Target.Interior.ColorIndex = 48
Target.Font.ColorIndex = 1
End If
If Target.Value = "R" Then
Target.Interior.ColorIndex = 35
Target.Font.ColorIndex = 1
End If
If Target.Value = "$" Then
Target.Interior.ColorIndex = 9
Target.Font.ColorIndex = 1
End If
If Target.Value = "L" Then
Target.Interior.ColorIndex = 23
Target.Font.ColorIndex = 1
End If
If Target.Value = "II" Then
Target.Interior.ColorIndex = 27
Target.Font.ColorIndex = 1
End If
If Target.Value = "III" Then
Target.Interior.ColorIndex = 14
Target.Font.ColorIndex = 1
End If
If Target.Value = "" Then
Target.Interior.ColorIndex = 2
End If
End Sub
Habe mir diesen Code über google beschaffen der tut es auch einwandfrei. leider nur dann wen ich den in die Arbeitsmappe einfüge. das Problem dabei ich habe 30 von diesen und in jeder soll das gemacht werden. jeder kann sich vorstellen was es heißt falls da mal Änderungen vorgenommen werden müssen
kann mir bitte einer diesen Code so verändern das ich den einfach als Makro in ein Button einfügen kann.
Private Sub Worksheet_Change( _
ByVal Target As Excel.Range)
If Intersect(Target, Range("C5:C21")) _
Is Nothing Then Exit Sub
If Target.Value = "Test" Then
Target.Interior.ColorIndex = 4
Target.Font.ColorIndex = 1
End If
If Target.Value = "%" Then
Target.Interior.ColorIndex = 54
Target.Font.ColorIndex = 1
End If
If Target.Value = "K" Then
Target.Interior.ColorIndex = 10
Target.Font.ColorIndex = 1
End If
If Target.Value = "2" Then
Target.Interior.ColorIndex = 27
Target.Font.ColorIndex = 1
End If
If Target.Value = "3" Then
Target.Interior.ColorIndex = 14
Target.Font.ColorIndex = 1
End If
If Target.Value = "A" Then
Target.Interior.ColorIndex = 48
Target.Font.ColorIndex = 1
End If
If Target.Value = "R" Then
Target.Interior.ColorIndex = 35
Target.Font.ColorIndex = 1
End If
If Target.Value = "$" Then
Target.Interior.ColorIndex = 9
Target.Font.ColorIndex = 1
End If
If Target.Value = "L" Then
Target.Interior.ColorIndex = 23
Target.Font.ColorIndex = 1
End If
If Target.Value = "II" Then
Target.Interior.ColorIndex = 27
Target.Font.ColorIndex = 1
End If
If Target.Value = "III" Then
Target.Interior.ColorIndex = 14
Target.Font.ColorIndex = 1
End If
If Target.Value = "" Then
Target.Interior.ColorIndex = 2
End If
End Sub
Habe mir diesen Code über google beschaffen der tut es auch einwandfrei. leider nur dann wen ich den in die Arbeitsmappe einfüge. das Problem dabei ich habe 30 von diesen und in jeder soll das gemacht werden. jeder kann sich vorstellen was es heißt falls da mal Änderungen vorgenommen werden müssen
Antwort 1 von Hajo_Zi vom 08.01.2019, 14:01 Options
Hallo Namensloser,
Option Explicit
Private Sub CommandButton1_Click()
Dim RaZelle As Range
For Each RaZelle In Range("C5:C21")
With RaZelle
Select Case .Value
Case "Test"
.Interior.ColorIndex = 4
.Font.ColorIndex = 1
Case "%"
.Interior.ColorIndex = 54
.Font.ColorIndex = 1
Case "K"
.Interior.ColorIndex = 10
.Font.ColorIndex = 1
Case 2, "II"
.Interior.ColorIndex = 27
.Font.ColorIndex = 1
Case 3, "III"
.Interior.ColorIndex = 14
.Font.ColorIndex = 1
Case "A"
.Interior.ColorIndex = 48
.Font.ColorIndex = 1
Case "R"
.Interior.ColorIndex = 35
.Font.ColorIndex = 1
Case "$"
.Interior.ColorIndex = 9
.Font.ColorIndex = 1
Case "L"
.Interior.ColorIndex = 23
.Font.ColorIndex = 1
Case ""
.Interior.ColorIndex = 2
End Select
End With
Next RaZelle
End Sub
Gruß Hajo
Option Explicit
Private Sub CommandButton1_Click()
Dim RaZelle As Range
For Each RaZelle In Range("C5:C21")
With RaZelle
Select Case .Value
Case "Test"
.Interior.ColorIndex = 4
.Font.ColorIndex = 1
Case "%"
.Interior.ColorIndex = 54
.Font.ColorIndex = 1
Case "K"
.Interior.ColorIndex = 10
.Font.ColorIndex = 1
Case 2, "II"
.Interior.ColorIndex = 27
.Font.ColorIndex = 1
Case 3, "III"
.Interior.ColorIndex = 14
.Font.ColorIndex = 1
Case "A"
.Interior.ColorIndex = 48
.Font.ColorIndex = 1
Case "R"
.Interior.ColorIndex = 35
.Font.ColorIndex = 1
Case "$"
.Interior.ColorIndex = 9
.Font.ColorIndex = 1
Case "L"
.Interior.ColorIndex = 23
.Font.ColorIndex = 1
Case ""
.Interior.ColorIndex = 2
End Select
End With
Next RaZelle
End Sub
Gruß Hajo
Ähnliche Themen
Macro-Aufruf
wolfram 16.04.2007 - 156 Hits - 2 Antworten
macro über einen command button
bambambigelow 11.08.2007 - 72 Hits - 3 Antworten
ich möchte ein Macro unter Excel beenden nud direkt speichern
LothiWi 24.01.2008 - 56 Hits -
Macro zuweisen
gast89 23.03.2008 - 25 Hits - 1 Antwort
Hinweis
Diese Frage ist schon etwas älter, Sie können daher nicht mehr auf sie antworten. Sollte Ihre Frage noch nicht gelöst sein, stellen Sie einfach eine neue Frage im Forum..
Neue Einträge
