Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
984to988
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
984to988
984to988
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

VBA Problem

VBA Problem
22.06.2008 22:53:00
Peter
Hallo
ich habe hier diesen Code bei dem ich mit Rechtsklick Zellen färben kann. Ich bin jetzt aber beim Maximum der Zelleingabe angelangt. Ich bekomme die Meldung "Bezeichner zu lang". Ich müßte aber 4X so viele Zellen eingeben. Wie kann ich den Code umstellen das es klappt. Bitte um hilfe !!!
Gruß Peter

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect([B4,D4,F4,H4,J4,L4,N4,P4,R4,T4,V4,X4,Z4,AB4,AD4,AF4,AH4,AJ4,AL4,AN4,AP4,AR4, _
AT4,AV4,AX4,AZ4,BB4,BF4,BH4,BJ4,BL4,BN4,BP4,BR4,BT4,BV4,BX4,BZ4,CB4,CD4,CF4,B6,D6,F6,H6,J6,L6,N6,P6,R6,T6,V6,X6,Z6,AB6,AD6,AF6,AH6,AJ6,AL6,AN6,AP6,AR6,AT6,AV6,AX6,AZ6;BB6,BF6,BH6], Target) Is Nothing Then
If Target.Interior.ColorIndex = 5 Then
Target.Interior.ColorIndex = x1None
Else
Target.Interior.ColorIndex = 5
End If
Cancel = True
End If
End Sub


9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Problem
22.06.2008 23:01:00
Hajo_Zi
Hallo Peter,
vielleicht hilft diese schreibweise.
' Set RaBereich = Union(Range("C11:AG11 , C13:AG13, C15:AG15 , C17:AG17 , C19:AG19 , C21:AG21 , C27:AE27 , C29:AE29, C31:AE31, C33:AE33"), _
' Range("C35:AE35, C37:AE37, C43:AG43, C45:AG45 , C47:AG47 , C49:AG49 ,C51:AG51 , C53:AG53 , C59:AF59 , C61:AF61 , C63:AF63 , C65:AF65"), _
' Range("C67:AF67 , C69:AF69 , C75:AG75 , C77:AG77 , C79:AG79 , C81:AG81 , C83:AG83 , C85:AG85 ,C91:AF91 , C93:AF93 , C95:AF95 , C97:AF97"), _
' Range("C99:AF99 , C101:AF101, C107:AG107 , C109:AG109 , C111:AG111 , C113:AG113 , C115:AG115 , C117:AG117 , C123:AG123 , C125:AG125"), _
' Range("C127:AG127 , C129:AG129 , C131:AG131 , C133:AG133 , C139:AF139 , C141:AF141 , C143:AF143 , C145:AF145 , C147:AF147 , C149:AF149"), _
' Range("C155:AG155, C157:AG157 , C159:AG159 , C161:AG161 , C163:AG163 , C165:AG165 , C171:AF171 , C173:AF173 , C175:AF175 , C177:AF177 "), _
' Range("C179:AF179 , C181:AF181, C187:AG187 , C189:AG189 , C191:AG191 , C193:AG193 , C195:AG195 , C197:AG197"))
' Zelle die in dem Bereich liegen auf die Varible schreiben
' damit werden nur noch die Zellen bearbeitet die im vorgegeben Bereich liegen
' jede Zelladresse ist einzeln angegeben
Set RaBereich = Intersect(RaBereich, Range(Target.Address))
If RaBereich Is Nothing Then Exit Sub

Anzeige
AW: VBA Problem
23.06.2008 04:57:00
fcs
Hallo Peter,
hier der Vorschlag von Boris umgesetzt auf deine Zellbereiche.

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Select Case Target.Row
Case 4, 6
'In Zeilen 4 und 6 die Zellfarbe in Spalte 2(B),  bis _
84 (CF) in den geraden Spalten ändern
If Target.Column Mod 2 = 0 And Target.Column >= 2 And Target.Column 


Gruß
Franz

AW: VBA Problem
24.06.2008 10:45:00
Peter
Hallo Franz
klappt super. Hätte da aber noch Bereiche. Und zwar, V34, Z34, AD34, AH34, AL34, AP34, AT34, BP34, BX34, B36, F36, V36, BP36, AX41, BF41, BX41, CF41. Ich weis aber nicht wie ich die in den Code einbauen soll. Ich hoffe du kannst mir dabei noch helfen.
Gruß Peter

Anzeige
AW: VBA Problem
24.06.2008 12:39:00
fcs
Hallo Peter,
ich hab die Prozedur ein wenig angepasst. Jetzt sollte es auch leichter fallen weitere Zellen zu ergänzen.
Gruß
Franz

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Select Case Target.Row
Case 4, 6 'In Zeilen 4 und 6 die Zellfarbe ändern
Select Case Target.Column
Case 2 To 84 'in Spalte B bis CF in jeder 2 Spalten
'in jeder zweiten Spalte Zellfarbeändern
If Target.Column Mod 2 = 2 Mod 2 Then
Call FarbeWechseln(objZelle:=Target, lngColorIndex:=5)
Cancel = True
End If
End Select
Case 34 'In Zeile 34 die Zellfarbe ändern
Select Case Target.Column
Case 22 To 46 'Spalte V bis AT
' in jeder dritten Spalte Zellfarbeändern
If Target.Column Mod 3 = 22 Mod 3 Then
Call FarbeWechseln(objZelle:=Target, lngColorIndex:=5)
Cancel = True
End If
Case 68, 76 'Spalte BP und BX Zellfarbe ändern
Call FarbeWechseln(objZelle:=Target, lngColorIndex:=5)
Cancel = True
End Select
Case 36 'In Zeile 36 Zellfarbe ändern
Select Case Target.Column
Case 2, 6, 22, 68 ' in Spalten B,F,V,BP
Call FarbeWechseln(objZelle:=Target, lngColorIndex:=5)
Cancel = True
End Select
Case 41 'In Zeile 41 Zellfarbe ändern
Select Case Target.Column
Case 50, 58, 76, 84 'in Spalten AX,BF,BX,CF
Call FarbeWechseln(objZelle:=Target, lngColorIndex:=5)
Cancel = True
End Select
Case Else
'do nothing
End Select
End Sub
Private Sub FarbeWechseln(objZelle As Range, lngColorIndex As Long)
If objZelle.Interior.ColorIndex = lngColorIndex Then
objZelle.Interior.ColorIndex = xlColorIndexNone
Else
objZelle.Interior.ColorIndex = lngColorIndex
End If
End Sub


Anzeige
AW: VBA Problem--Danke :-))
27.06.2008 23:00:34
Peter
Hallo Franz
vielen vielen dank für deine Hilfe. Klappt alles super. Danke
Gruß Peter

AW: VBA Problem
29.06.2008 16:10:10
Peter
Hallo Leute
der Code von Franz ist ja Cool. Klappt super. Hätte da aber noch eine Frage? Wie kann ich den Code ändern das ich die Zelle mit einem Kreutz füllt. Hab das ganze mit dem MakroRecorder aufgezeichnet wie es aussehen soll. Krieg is leider nicht hin. Könnt ihr mir Helfen ?
Gruß Peter
Hier der Code !!!

Sub KreutzSetzen()
With Selection.Borders(xlDiagonalDown)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlDiagonalUp)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
End Sub



Sub KreutzEntfernen()
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
End Sub


Anzeige
AW: VBA Problem
22.06.2008 23:02:00
{Boris}
Hi Peter,
aus der Hand:

If Target.Row = 4 And Target.Column Mod 2 = 0 Then
If Target.Interior.ColorIndex = 5 Then
Target.Interior.ColorIndex = x1None
Else
Target.Interior.ColorIndex = 5
End If
Cancel = True
End If
End If


Grüße Boris

Da waren natürlich...
22.06.2008 23:03:00
{Boris}
...die If-/End If nicht korrekt - aber es kam ja nur auf die erste Zeile an.
Grüße Boris

AW: VBA Problem
22.06.2008 23:26:51
Peter
Hi
bin nicht so gut in VBA. Komme nicht ganz klar mit dem umstellen des Codes. Es will nicht klappen. Könnt ihr mir noch mal helfen?
Gruß Peter

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige