Codeproblem bei Textcheck

Guten Morgen liebes Forum,
ich komme leider mit meiner Excel-Datei nicht so recht weiter. Der folgende Code, den ich mit viel Hilfe und der Aufzeichnenfunktion zusammengefügt habe, funktioniert ganz gut:
Sub Textfeld16_BeiKlick()
With ActiveSheet
Range("A2").Select
.Unprotect Password:="123"
.ShowDataForm
Range("A2:H20").Select
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("B2").Select
Dim I As Integer
Range("A3:A20").Rows.AutoFit
For I = 3 To 20
With Rows(I)
.RowHeight = .RowHeight + 10
End With
Next
.Protect Password:="123"
End With
End Sub
Das einzige, was mich stört, ist, dass daraus, wenn man die Tabelle dann über Datei\Senden an\Mailempfänger versendet, ein 45seitiges Dokument wird. :-(
Zu diesem Problemschen habe ich jetzt aber leider noch weitere Anforderungen an den Code erhalten:
- Ist es möglich, abhängig davon, ob Text im Bereich A2:H20 ist, jede zweite
Zeile mit einem bestimmte Grauton zu versehen?
- Ist es möglich, nur die Zeilen in der Höhe anzupassen, in denen wirklich Text ist?
Ich habe nach Recherchen einen Code gefunden:


Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("b3:b50")) Is Nothing Then
If Target.Text = True Then
MsgBox ("1") ' hier dein Makro
Else
Exit Sub
End If
Else
Exit Sub
End If
End Sub

Den habe ich versucht anzupassen und einzubinden. Bin aber immer gescheitert. Könntet Ihr mir vielleicht helfen?
Großes Dankeschön - auch für die Dinge, die durch Euch ich bereits lernen durfte
Claudia

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Textfeld16_BeiKlick() Dim I As Integer, rng As Range, bolEmpty As Boolean With ActiveSheet .Unprotect Password:="123" .ShowDataForm With Range("A2:H20") .Sort Key1:=Range("B2"), Order1:=xlAscending For Each rng In Range("A2:H20") If IsEmpty(rng) Then bolEmpty = False Else bolEmpty = True Exit For End If Next If bolEmpty Then For I = 2 To 20 If I Mod 2 = 0 Then Rows(I).Interior.ColorIndex = 15 Next End If End With Range("A3:A20").Rows.AutoFit .Protect Password:="123" End With End Sub

Hi Roland,
Du hast ja Recht. Ich habe mich etwas komisch ausgedrückt. Hintergrund ist, dass die Tabelle versandt wird. Die Überschrift ist grau formatiert. Um nun die darunter stehenden einzelnen Datensätze von einander abzuheben, wäre es toll, wenn die jeweils zweite Zeile, die mit Text gefüllt ist, grau markiert wird. Wenn aber kein Text mehr kommt, soll bei "keiner Hintergrundfarbe" verblieben werden. Ich weiß nun leider nicht, ob das überhaupt möglich ist. Bei den Optionen, die Du oben aufgeführt hast, wäre es glaube ich
-jede zweite Zeile ab einem Punkt (Überschrift) checken, ob Text vorhanden ist und diese Zeilen (vielleicht auch nur die Zellen?) dann grau, sonst nichts.
Ich kenne mich leider überhaupt nicht aus. :-(((
Hast Du vielleicht einen Tipp?
Ganz herzlichen Dank
Claudia

Sub Textfeld16_BeiKlick() Dim I As Integer, j As Byte, k As Byte With ActiveSheet .Unprotect Password:="123" .ShowDataForm Range("A2:H20").Sort Key1:=Range("B2"), Order1:=xlAscending k = 1 For I = 2 To 20 For j = 1 To 8 If Not IsEmpty(Cells(I, j)) Then k = k + 1 Exit For End If Next If k Mod 2 = 0 Then Rows(I).Interior.ColorIndex = 15 Next Range("A3:A20").Rows.AutoFit .Protect Password:="123" End With End Sub

Sub Textfeld16_BeiKlick() Dim I As Integer, j As Byte, k As Byte With ActiveSheet .Unprotect Password:="123" .ShowDataForm Range("A2:H20").Sort Key1:=Range("B2"), Order1:=xlAscending k = 1 For I = 4 To 20 For j = 1 To 8 If Not IsEmpty(Cells(I, j)) Then k = k + 1 If k Mod 2 = 0 Then Range("A" & I & ":H" & I).Interior.ColorIndex = 15 Exit For End If Next Next Range("A3:A20").Rows.AutoFit .Protect Password:="123" End With End Sub

Sub Textfeld16_BeiKlick() Dim I As Integer, j As Byte, k As Byte Application.DisplayAlerts = False With ActiveSheet .Unprotect Password:="123" .ShowDataForm Range("A2:H20").Sort Key1:=Range("B2"), Order1:=xlAscending k = 1 For I = 4 To 20 For j = 1 To 8 If Not IsEmpty(Cells(I, j)) Then k = k + 1 If k Mod 2 = 0 Then Range("A" & I & ":H" & I).Interior.ColorIndex = 15 Exit For End If Next Next Range("A3:A20").Rows.AutoFit .Protect Password:="123" End With Application.DisplayAlerts = True End Sub

Beliebteste Forumthreads (12 Monate)

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread