title image


Smiley Re: Frage zu Borders...
Hallo,



das kannst du so lösen:



Option Explicit

Option Base 1

Sub Rahmen()

Dim rngS As Range, c As Range, i As Long, cc As Long

Dim arr() As Variant

'Set rngS = Selection

'oder Zellbereich angeben

Set rngS = [b2:b20]

cc = rngS.Count

ReDim arr(cc, 6)

Application.ScreenUpdating = False

For Each c In rngS

On Error Resume Next

i = i + 1

With c.Borders(7)

arr(i, 1) = .LineStyle

arr(i, 2) = .Weight

arr(i, 3) = .ColorIndex

End With

With c.Borders(10)

arr(i, 4) = .LineStyle

arr(i, 5) = .Weight

arr(i, 6) = .ColorIndex

End With

Next

rngS.Borders.LineStyle = -4142

i = 0

For Each c In rngS

On Error Resume Next

i = i + 1

With c.Borders(10)

.LineStyle = arr(i, 1)

.Weight = arr(i, 2)

.ColorIndex = arr(i, 3)

End With

With c.Borders(7)

.LineStyle = arr(i, 4)

.Weight = arr(i, 5)

.ColorIndex = arr(i, 6)

End With

Next

Application.ScreenUpdating = True

End

End Sub



Gruß M.I.Nitraum



geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: