Gitternetz

Forumthread: Gitternetz

Gitternetz

11.04.2006 14:41:24

Jusuf

Hallo Forum,
Ich möchte mit VBA ein Gitternetz in Tabelle1, wie in hochgeladene Mappe dargestellt, erreichen. Wer kann mir helfen?
https://www.herber.de/bbs/user/32771.xls
Mit freundlichen Grüßen
Jusuf

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Gitternetz

11.04.2006 16:22:16

Ulf
AW: Gitternetz

11.04.2006 16:29:51

Franz
AW: Gitternetz

11.04.2006 16:37:51

IngGi
AW: Gitternetz

11.04.2006 18:26:41

Jusuf
AW: Gitternetz

11.04.2006 18:33:32

Jusuf

AW: Gitternetz

11.04.2006 16:22:16

Ulf

Hallo Jusuf
bischen zusammengebastelt aber funktioniert
geht bestimmt noch eleganter
Option Explicit


Sub Makro1()
Dim w As Integer
Dim x As Integer
Dim y As Integer
Dim z As Integer
w = 10
x = 12
With Application
.ScreenUpdating = False
End With
For y = 10 To 210 Step 2
For z = 12 To 212 Step 2
Sheets(2).Range(Cells(y, z), Cells(y + 1, z + 1)).Borders(xlEdgeLeft).LineStyle = xlContinuous
Sheets(2).Range(Cells(y, z), Cells(y + 1, z + 1)).Borders(xlEdgeTop).LineStyle = xlContinuous
Sheets(2).Range(Cells(y, z), Cells(y + 1, z + 1)).Borders(xlEdgeBottom).LineStyle = xlContinuous
Sheets(2).Range(Cells(y, z), Cells(y + 1, z + 1)).Borders(xlEdgeRight).LineStyle = xlContinuous
If w = y And x = z Then
Sheets(2).Range(Cells(y, z), Cells(y + 1, z + 1)).Interior.ColorIndex = 15
w = w + 2
x = x + 2
End If
Next z
Next y
With Application
.ScreenUpdating = True
End With
End Sub

mfg Ulf

AW: Gitternetz

11.04.2006 16:29:51

Franz

Hallo Jusuf,
hier das VBA Makro, mit dem der Tabellenbereich wie gewünscht formatiert werden kann.

Sub BereichFormatieren()
Dim Bereich As Range, Zellen As Range
Set Bereich = ThisWorkbook.ActiveSheet.Range("L10:HE211")
Bereich.Borders.LineStyle = xlNone 'Linien Löschen
Bereich.Interior.ColorIndex = xlColorIndexNone 'Füllfarbe löschen
'horizontale Linien
For I = 0 To Bereich.Rows.Count - 1 Step 2
Set Zellen = Range(Cells(Bereich.Row + I, Bereich.Column), Cells(Bereich.Row + I, Bereich.Column + Bereich.Columns.Count - 1))
With Zellen.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Next
With Bereich.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
'Vertikale Linien
For I = 0 To Bereich.Columns.Count - 1 Step 2
Set Zellen = Range(Cells(Bereich.Row, Bereich.Column + I), Cells(Bereich.Row + Bereich.Rows.Count - 1, Bereich.Column + I))
With Zellen.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Next
With Bereich.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
' Felder Grau füllen
Z = Bereich.Row
S = Bereich.Column
Do Until Z > Bereich.Row + Bereich.Rows.Count - 1 Or S > Bereich.Column + Bereich.Columns.Count - 1
Set Zellen = Cells(Z, S).Range("A1:B2")
Zellen.Interior.ColorIndex = 15
Z = Z + 2
S = S + 2
Loop
End Sub

Gruß
Franz

AW: Gitternetz

11.04.2006 16:37:51

IngGi

Hallo Jusuf,
das geht zum Beispiel so:


Sub Rahmen()
Dim rng As Range
Dim ze As Integer
Dim sp As Integer
Application.ScreenUpdating = False
Set rng = Range("L10:M11")
For ze = 1 To 101
For sp = 1 To 101
With rng.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With rng.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With rng.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
End With
With rng.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
End With
If ze = sp Then
rng.Interior.ColorIndex = 15
End If
Set rng = rng.Offset(0, 2)
Next 'sp
Set rng = rng.Offset(2, -202)
Next 'ze
Application.ScreenUpdating = True
End Sub

Gruß Ingolf

AW: Gitternetz

11.04.2006 18:26:41

Jusuf

Hallo Ulf, Franz und IngGi
an alle drei noch mal vielen Dank. Makros funktionieren prima. Das war große Hilfe für mich.
Mit freundlichen Grüßen
Jusuf

AW: Gitternetz

11.04.2006 18:33:32

Jusuf

Hallo Ulf, Franz und IngGi
an alle drei noch mal vielen Dank. Makros funktionieren prima. Das war große Hilfe für mich.
Mit freundlichen Grüßen
Jusuf

Beliebteste Forumthreads (12 Monate)

Forumthread: Gitternetz

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread