Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1556to1560
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
Inhaltsverzeichnis

Gitternetzlinie schwarz

Gitternetzlinie schwarz
13.05.2017 13:33:31
Peter
Hallo zusammen
Wie müsste eine Script aussehen, wenn jeweils in Spalte J, N, Z, AG, AK, AO, AQ und AU, links eine schwarze Gitternetzlinie gezeichnet werden soll. Dies ab der 4. Zeile und jeweils nur so weit runter, wie Werte in C4:C enthalten sind.
Folgende Formatierung:
    With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
Danke
Viele Grüsse,
Peter

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Gitternetzlinie schwarz
13.05.2017 13:54:00
Hajo_Zi
Hallo Peter,
Option Explicit
Sub Rahmen()
Dim LoLetzte As Long
Dim StWert As String
Dim LoI As Long
Dim arrFormTabSplit
LoLetzte = IIf(IsEmpty(Cells(Rows.Count, 3)), Cells(Rows.Count, 3).End(xlUp).Row, Rows. _
Count)
StWert = "J, N, Z, AG, AK, AO, AQ, AU"
arrFormTabSplit = Split(StWert, ",")
For LoI = 0 To UBound(arrFormTabSplit)
With Range(arrFormTabSplit(LoI) & "1:" & arrFormTabSplit(LoI) & LoLetzte).Borders( _
xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
Next
End Sub

Anzeige
AW: Gitternetzlinie schwarz
13.05.2017 15:35:47
Peter
Hallo Hajo
Wauh, echt super, läuft bestens, Du hast mir sehr geholfen, DANKE!
Viele Grüsse,
Peter
AW: Gitternetzlinie schwarz
13.05.2017 13:58:52
fcs
Hallo Peter,
etwa so
Sub prcLinien()
Dim Spalte As Long, Zeile_L As Long
Dim wks As Worksheet
Set wks = ActiveSheet
Application.ScreenUpdating = False
With wks
Zeile_L = .Cells(.Rows.Count, 3).End(xlUp).Row
If Zeile_L >= 4 Then
For Spalte = 1 To .UsedRange.Column + .UsedRange.Columns.Count - 1
Select Case Spalte
Case 10, 14, 26, 33, 37, 41, 43, 47 'J, N, Z, AG, AK, AO, AQ und AU
With .Range(.Cells(4, Spalte), .Cells(Zeile_L, Spalte))
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
End With
End Select
Next
End If
End With
Application.ScreenUpdating = True
End Sub

LG
Franz
Anzeige
AW: Gitternetzlinie schwarz
13.05.2017 15:17:51
Daniel
Hi
With Intersect(Range("C4:C" & Cells(rows.count, 3).end(xlup).Row).EntireRow, _
Range("J1,N1,Z1,AG1,AK1,AO1,AQ1,AU1").EntireColumn).Borders(xledgeleft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
Gruß Daniel

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige