Diagonale in Zelle in Abhängigkeit

Forumthread: Diagonale in Zelle in Abhängigkeit

24.11.2013 11:04:01

Daniela

Guten Morgen,
Ich suche eine Möglichkeit folgendes zu realisieren, mit bedingter Formatierung geht das leider nicht:
Wenn in einer Spalte in der 5. Zelle (A5; B5; ...) ein Datum enthalten ist, soll jede weitere Zelle in der jeweiligen Spalte (A10:A150; B10:B150 ...) die keinen Wert enthält mit einer diagonalen Line versehen werden.
Wie ich Linie erzeuge habe ich bereits gefunden:

Sub test1()
With Range("A10:A150").SpecialCells(xlCellTypeBlanks).Borders(xlDiagonalDown)
.LineStyle = xlDot
.Weight = xlThin
'        .Color = RGB(0, 0, 0)
.ColorIndex = xlAutomatic
End With
End Sub

Wie verknüpfe ich das mit der Bedingung (Datum in Zelle 5) ?
Für Tipps bin ich sehr dankbar.
VG

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Diagonale in Zelle in Abhängigkeit

24.11.2013 12:15:28

Tino

Hallo,
hoffe habe dich richtig verstanden?!
Kannst mal so versuchen/testen.

Sub Test1()
Dim nCol&
Dim rng As Range
Dim objLinie As Shape
Dim oTabelle As Worksheet
'Tabelle anpassen 
Set oTabelle = Tabelle1

On Error GoTo ErrorHandler:
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    
    With oTabelle
        Kill_Linie oTabelle
        nCol = .Cells(5, .Columns.Count).End(xlToLeft).Column
        For nCol = 1 To nCol
            If .Cells(5, nCol) <> "" Then
                Set rng = FindLeerZelle(.Range(.Cells(5, nCol), .Cells(150, nCol)))
                If Not rng Is Nothing Then
                    For Each rng In rng.Areas
                        With rng
                            Set objLinie = oTabelle.Shapes.AddLine(.Left + .Width / 2, _
                                                           .Top, _
                                                           .Left + .Width / 2, _
                                                           .Cells(.Rows.Count, 1).Top + .Cells(.Rows.Count, 1).Height)
                        End With
                        
                        'sonstige Formatierung 
                        With objLinie.Line
                            .Weight = 2
                            .ForeColor.RGB = RGB(164, 166, 164)
                        End With
                    Next rng
                End If
            End If
        Next nCol
    End With

ErrorHandler:
    .ScreenUpdating = True
    .EnableEvents = True
End With

If Err.Number <> 0 Then
    MsgBox Err.Description, _
       vbCritical + vbMsgBoxSetForeground + vbMsgBoxHelpButton, _
       "Error: " & Err.Number, Err.HelpFile, Err.HelpContext
End If
End Sub

Private Function FindLeerZelle(rngBereich As Range) As Range
On Error Resume Next
Set FindLeerZelle = rngBereich.SpecialCells(xlCellTypeBlanks)
End Function

Private Sub Kill_Linie(objTabelle As Object)
Dim oShape As Shape
For Each oShape In Tabelle1.Shapes
    If oShape.Type = msoLine Then oShape.Delete
Next oShape
End Sub

Gruß Tino

AW: Diagonale in Zelle in Abhängigkeit

24.11.2013 13:07:49

Daniela

Hallo Tino,
dank für deine Hilfe !
Der Ansatz ist schon richtig, jedoch soll anstatt einer senkrechten Line in jeder leeren Zelle ein diagonaler Strich (Rahmen) sein.
Habe zwischenzeitlich selber weiter experimentiert und zumindest es direkt zellbezogen hinbekommen.
Hier mein Beispiel:

Sub test1()
If Range("ZELLE 5").Value  1 Then
With Range("ZELLE 10:ZELLE 150").SpecialCells(xlCellTypeBlanks).Borders(xlDiagonalDown)
.LineStyle = xlDot
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End If
End Sub

Wie lasse ich jeweils Zelle 5 jeder Spalte prüfen damit dann in Zelle 10:150 der selben Spalte die Aktion ausgeführt wird ohne bestimmte Zellen einzeln (A5 etc.) direkt anzusprechen.
VG

Das sollte so gehen, ...

24.11.2013 13:21:49

Luc:-?

…Daniela:

Sub test1()
Dim xCol As Range
For Each xCol In UsedRange.Columns
If xCol(5).Value  1 Then
With xCol.SpecialCells(xlCellTypeBlanks).Borders(xlDiagonalDown)
.LineStyle = xlDot
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End If
Next xCol
End Sub

Gruß Luc :-?

AW: Laufzeitfehler, ...

24.11.2013 13:38:27

Daniela

Bekomme Laufzeitfehler 13 - Typen unverträglich :-(

AW: Laufzeitfehler, ...

24.11.2013 13:46:12

Tino

Hallo,
meinst Du so?
https://www.herber.de/bbs/user/88232.xls
Gruß Tino

AW: Laufzeitfehler, ...

24.11.2013 14:18:42

Daniela

@ Tino
vom Code her 100 % richtig nur statt senkrechter Linie eine diagonale (Rahmen)
siehe mein altes Beispiel:
https://www.herber.de/bbs/user/88233.xls
VG Dani

AW: Laufzeitfehler, ...

24.11.2013 14:42:37

Tino

Hallo,
ok. jetzt habe ich verstanden, denke ich?!
Evtl. das aussehen noch anpassen in den Zeilen

LStyle = xlContinuous 'Style
LWeight = 1           'Breite
LColorIndex = 0       'Farbe

Die Datei https://www.herber.de/bbs/user/88235.xls wurde aus Datenschutzgründen gelöscht

Gruß Tino

AW: Laufzeitfehler, ...

24.11.2013 14:59:09

Daniela

Perfekt !!! DANKE !!! :-)

xCol.Cells(5) wäre ggf besser gewesen! ;-) owT

26.11.2013 01:00:27

Luc:-?

:-?

Beliebteste Forumthreads (12 Monate)

Diagonale in Zelle in Abhängigkeit

Forumthread: Diagonale in Zelle in Abhängigkeit

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Diagonale in Zelle in Abhängigkeit

Forumthread: Diagonale in Zelle in Abhängigkeit

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

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread