Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
752to756
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
752to756
752to756
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

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
Anzeige
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
Anzeige
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
Anzeige
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
Anzeige
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)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige