Excel makro: Mehrere Bereiche mit Rahmen

falcons · 24.06.2005

Hallo Zusammen,

ich habe folgendes Makro:

Code:

Set r = wsc.Range(Array(M2:O11, M17:O26, M32:O41))
  r.Borders(xlDiagonalDown).LineStyle = xlNone
  r.Borders(xlDiagonalUp).LineStyle = xlNone
    
  With r.Borders(xlEdgeLeft)
      .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
  End With
  With r.Borders(xlEdgeTop)
      .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
  End With
  With r.Borders(xlEdgeBottom)
      .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
  End With
  With r.Borders(xlEdgeRight)
      .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
  End With
  With r.Borders(xlInsideVertical)
      .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
  End With
  With r.Borders(xlInsideHorizontal)
      .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
  End With

wenn ich

Set r = wsc.Range(Array(M2:O11, M17:O26, M32:O41))

mit
Set r = wsc.Range(M32:O41)
austausche dann funktionierts.

Wie schaffe ich es das gleichzeitig mehrere Bereiche mit Rahmen versehen werden?
Was ist falsch an meinem Makro?

Danke im Voraus.

Grüße
falcon30

Billy · 24.06.2005

wie wärs mit:

Code:

Set r = wsc.RangeM2:O11, M17:O26, M32:O41)

geht das?

kanns im mom leider net testen

zügel stress

falcons · 24.06.2005

Hi,

Set r = wsc.Range(M2:O11, M17:O26, M32:O41)

tutet leider nicht. :'(

Grüße
falcon30

Matjes · 24.06.2005

Hi falcon,

man könnte das folgendermassen machen:

Code:

Option Explicit

Sub Beispiel_mygrids()
  
  Dim wsc As Worksheet
  Dim r As Range
  
  
  Set wsc = ActiveSheet->dies ist nur hier im TestProg notwendig
  
  Set r = wsc.Range(M2:O11)
  Call SetGridSimple(r)
  Set r = wsc.Range(M17:O26)
  Call SetGridSimple(r)
  Set r = wsc.Range(M32:O41)
  Call SetGridSimple(r)
  
  Set r = Nothing
End Sub

'******************************************
Function SetGridSimple(r As Range)
  On Error Resume Next
  r.Borders(xlDiagonalDown).LineStyle = xlNone
  r.Borders(xlDiagonalUp).LineStyle = xlNone
    
  With r.Borders(xlEdgeLeft)
      .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
  End With
  With r.Borders(xlEdgeTop)
      .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
  End With
  With r.Borders(xlEdgeBottom)
      .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
  End With
  With r.Borders(xlEdgeRight)
      .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
  End With
  With r.Borders(xlInsideVertical)
      .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
  End With
  With r.Borders(xlInsideHorizontal)
      .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
  End With
  On Error GoTo 0
End Function

Gruß Matjes

Matjes · 24.06.2005

und wenn es denn unbedingt in einem Rutsch sein muß

Code:

Option Explicit

Sub Beispiel_mygrids_undUnion()
 
 Dim wsc As Worksheet
 Dim r As Range
 
 
 Set wsc = ActiveSheet->dies ist nur hier im TestProg notwendig
 
 Set r = Application.Union( _
      wsc.Range(M2:O11), _
      wsc.Range(M17:O26), _
      wsc.Range(M32:O41))
 Call SetGridSimple(r)
 
 Set r = Nothing
End Sub
Function SetGridSimple(r As Range)
 On Error Resume Next
 r.Borders(xlDiagonalDown).LineStyle = xlNone
 r.Borders(xlDiagonalUp).LineStyle = xlNone
  
 With r.Borders(xlEdgeLeft)
   .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
 End With
 With r.Borders(xlEdgeTop)
   .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
 End With
 With r.Borders(xlEdgeBottom)
   .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
 End With
 With r.Borders(xlEdgeRight)
   .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
 End With
 With r.Borders(xlInsideVertical)
   .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
 End With
 With r.Borders(xlInsideHorizontal)
   .LineStyle = xlContinuous: .Weight = xlThin: .ColorIndex = xlAutomatic
 End With
 On Error GoTo 0
End Function

falcons · 24.06.2005

Hallo Matjes,

vielen Dank!!

Beide Makros tun genau das was ich wollte!!

Grüße
falcon30

Excel makro: Mehrere Bereiche mit Rahmen

falcons

Billy

falcons

Matjes

Matjes

falcons

Excel makro: Mehrere Bereiche mit Rahmen

ANGEBOTE & SPONSOREN

Neueste Themen

Statistik des Forums