Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
800to804
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
800to804
800to804
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Rahmen über VBA

Rahmen über VBA
19.09.2006 13:31:13
Heinz
Hallo Leute
Habe unteres Makro mittels Recorder aufgezeichnet.
Habe auch eine Beispielmappe hochgeladen.
Wenn kein Wert, dann kein Rahmen im Rechteck, sonst Rahmen.
Mit Bedingte Formatierung wird die Mappe so aufgebläht.
Denn es geht von B3 bis AX2013
Könnte mir dabei bitte jemand weiterhelfen ?
Danke, Heinz

Sub Rahmen()
' Rahmen Makro
Range("P19:V22").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Range("T21:U22").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
End Sub

Die Datei https://www.herber.de/bbs/user/36798.xls wurde aus Datenschutzgründen gelöscht

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Nachfrage
19.09.2006 18:39:00
Reinhard
Hi Heinz,
muß die Unterscheidung xlHairless und xlThin denn sein?
ps: Damit ich kein Makro aufzeichnen muss, was ist denn xlHairless (xlThinkenn ich)
Bei gleicher linie könnte man

With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
vekürzen zu:
for n=7 to 10
With Selection.Borders(n) 'Tip von K.Rola
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
next n

Gruß
Reinhard
ps: Ich freue mich über eine Rückmeldung ob diese Antwort hilfreich war oder nicht..
Anzeige
AW: Nachfrage
19.09.2006 18:53:14
Heinz
Hallo Reinhard
Natürlich kann es nur "xlHairless" sein.
Muss ich den Code in das Tab.Blatt "WoMat" Kopieren ? Oder.
Bitte könntest Du mir Hierzu noch weiterhelfen. Denn dann bin ich FERTIG und auch das Pogramm.
Danke & Gruss, Heinz
AW: Nachfrage
19.09.2006 20:40:07
Reinhard
Hi Heinz,
die Datei
https://www.herber.de/bbs/user/36819.xls
hat den folgenden Code (in einem Modul!)
Macht er für P18:V22 was du wolltest? War P19 ein Schreibfehler oder hat es eine Bedeutung?
Option Explicit
Sub Aus()
With Worksheets("WoMat")
.Range("P18:V22").Borders.LineStyle = xlNone
End With
End Sub
Sub Ein()
Dim n, Zelle
On Error GoTo ende
Application.ScreenUpdating = False
With Worksheets("WoMat")
For Each Zelle In .Range("P18:V22")
With Zelle
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
For n = 7 To 10
With .Borders(n)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Next n
End With
Next Zelle
End With
ende:
Application.ScreenUpdating = True
End Sub

Gruß
Reinhard
ps: Ich freue mich über eine Rückmeldung ob diese Antwort hilfreich war oder nicht..
Anzeige
AW: Nachfrage
19.09.2006 21:03:19
Heinz
Guten abend Reinhard
Wiederum recht herzlichen Dank für Deine Hilfe.
Funkt. prächtig !!
Natürlich konntest Du wieder meine Gedanken lesen. Es war P18 und nicht P19.
Nochmals Danke und Gute Nacht.
Heinz
AW: Rahmen über VBA
19.09.2006 21:17:03
fcs
Hallo Heinz,
ich habe ein wenig gebastelt und folgendes Makro ist dabei herausgekommen. Das Makro in ein Modul in der Datei einfügen und starten wenn die Tabelle angezeigt wird.
Das Makro formatiert die gesamte Tabelle korrekt, wenn diese ab Zelle B3 nach rechts/unten immer gleich strukturiert ist wie in dem Beispiel. Dabei wird eine Zwischenzeile für die "Kalenderwoche" erkannt und berücksichtigt.
Gruss
Franz

Sub Rahmen()
Dim wks As Worksheet, ZeileS As Long, SpalteS As Integer, DeltaZ As Integer, DeltaS As Integer
Dim Bereich As Range, Zelle As Range, i As Long, Tage As Long, Zeile As Long
Set wks = ActiveSheet
Application.ScreenUpdating = False
With wks
ZeileS = 3 'Startzeile
SpalteS = 2 'Startspalte (B)
DeltaZ = 5 'Zeilen pro Tag
DeltaS = 7 'Spalten pro Eintrag
MaxEintrag = Application.WorksheetFunction.CountA(.Range("B1:IV1")) 'max. Zahl Einträge pro Tag (311, 312, 321, etc.)
Tage = Application.WorksheetFunction.CountA(.Range(.Cells(3, "A"), .Cells(.Rows.Count, "A").End(xlUp))) / 2 ' Anzahl Tage in Liste
Zeile = ZeileS
For i = 1 To Tage
For spalte = 0 To MaxEintrag - 1
'Zelle links oben im zu formatierenden Eintrag
Set Zelle = .Cells(Zeile, SpalteS + spalte * DeltaS)
'Bereich mit Daten für einen Eintrag
Set Bereich = Zelle.Range("A1:G5")
'Rahmen um Daten des Eintrags als einfache Linie setzen, Eintrag ganz Links/Rechts/Unten mit Doppellinie
If spalte = 0 Then ' 1. Eintrag in Zeile, Spalte Links mit Doppellinie
With Bereich.Borders(xlEdgeLeft)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Else
With Bereich.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End If
If spalte = MaxEintrag - 1 Then 'Letzer Eintrag in Zeile, Spalte rechts mit Doppellinie
With Bereich.Borders(xlEdgeRight)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Else
With Bereich.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End If
With Bereich.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
If i = Tage Then 'Letzte Einträge unten mit Doppellinie
With Bereich.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Else
With Bereich.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End If
'Innenlinien entfernen
Bereich.Borders(xlInsideVertical).LineStyle = xlNone
Bereich.Borders(xlInsideHorizontal).LineStyle = xlNone
'Überprüfen, ob im Bereich des Eintrags Daten vorhanden sind
If Application.WorksheetFunction.CountA(Bereich) <> 0 Then
'Linien im Innenbereich formatieren
'Obere 3 Zeilen mit durchgehenden Haarlinien formatieren
Set Bereich = Zelle.Offset(1, 0).Range("A1:G2")
With Bereich.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Bereich.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Bereich.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
'Zellenblock 2 Zeilen 4 spalten unten Links formatieren
Set Bereich = Zelle.Offset(3, 0).Range("A1:D2")
With Bereich.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Bereich.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
'Zellenblock 2 Zeilen 3 Spalten unten rechts formatieren
Set Bereich = Zelle.Offset(3, 4).Range("A1:C2")
With Bereich.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Bereich.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
End If
Next spalte
Zeile = Zeile + DeltaZ
If .Cells(Zeile, SpalteS).Value = "Kalenderwoche" Then Zeile = Zeile + 1
Next i
End With
Application.ScreenUpdating = True
MsgBox "Formatierung abgeschlossen!"
End Sub
b

Anzeige
AW: Rahmen über VBA
19.09.2006 21:37:29
Heinz
Hallo Franz
Echt Super Geil Deine Idee.
Nur ein paar Fehler sind bei der Bestimmung der Rahmen.
Meistens bei jeder 2 Woche am Sonntag.
Wäre es unverschämt und nur natürlich wenn Du bereit bist, das man das Makro Kalenderwoche für Kalenderwoche machen könnte.Z.B. mit Doppelklick auf ein gewisse Stelle,oder anders.Aber Woche für Woche wäre der Absolute Hammer.
Habe das Tab.Blatt mit Deinen Code mal hochgeladen.
Ist nicht Dringend.
Muss jetzt in's Bettchen gehen morgen um 3:45 Uhr läutet der Wecker,dann wieder schaffen gehen.
Gute Nacht und recht herzlichen Dank
Gruss, Heinz
https://www.herber.de/bbs/user/36822.zip
Anzeige
AW: Rahmen über VBA
20.09.2006 01:07:56
fcs
Hallo Heinz,
ich habe das Makro jetzt noch etwas modifiziert, so dass die Gesamttabelle korrekt formatiert wird.
Eine Variante für die Formatierung eines Wochenplans ist ebenfalls drin.
Zum Starten der Wochenformatierung in Spalte A Zelle mit "Tag" in der Überschrift der Woche selektieren. Dann wird ein "dynamischer" Commandbutton in der Zelle rechts daneben positioniert. Mit dem Button kannst du das Makro zur Rahmen-Formatierung starten. Wichtig ist, dass vor dem Start des Makros immer die Zelle mit "Tag" aktiv ist, dies wird vom Makro geprüft. Das Makro zum Positionieren des Commandbuttons und den Code des Buttons findest du im Code der Tabelle.
https://www.herber.de/bbs/user/36832.zip
Gruss
Franz
Anzeige
AW: Rahmen über VBA
20.09.2006 14:21:00
Heinz
Hallo Franz
Ist echt eine SUPER Arbeit von Dir. Danke
BITTE eventuell noch eine kleine Änderung " NUR WENN MÖGLICH !! "
Könnte man das Ereignis mit den Rahmen nicht machen wenn ich In die Spalte A doppelklicke,
Wo daneben "Kalenderwoche" steht.
Begründung: Denn da habe ich ja schon ein Ereignis bei Doppelklick,so wie Du im Code Tab.Blatt " WoMat" ersehen kannst.
Also da bei Doppelklick in Zelle " A " neben " Kalenderwoche " beide Ereignisse ausgeführt werden.
Lade Dir mal die Komplette Mappe hoch.
Danke für Deine Imense Arbeit bis spät in die Nacht !!
Habe ein Contextmenü "Womat" erstellt.
Damit kannst Du selber testen.
https://www.herber.de/bbs/user/36853.zip
Nochmals recht herzlichen Dank.
Heinz
heinz_holzmann@aon.at
Anzeige
AW: Rahmen über VBA
20.09.2006 15:45:02
Heinz
Hallo Franz
Bitte nimm diese Datei.
Habe Deinen Button und Code zum öffnen der UserForm wenn du auf " Tag " klickst hergenommen.
Hier ist kein eigenes Contextmenü mehr enthalten.
Super Idee von Dir.
Gruss, Heinz
https://www.herber.de/bbs/user/36856.zip
AW: Rahmen über VBA
20.09.2006 19:18:16
Heinz
Hallo Franz
Habe es SELBST fertig gebracht, Deinen Code und Makro Anzupassen.(Siehe Datei)!!
Echt SUPER was Du da für mich geleistet hast.
Nochmals recht herzlichen Dank, für Deine ganzen Bemühungen !!
Gruss,Heinz
https://www.herber.de/bbs/user/36863.zip
Anzeige
AW: Rahmen über VBA
20.09.2006 22:23:40
fcs
Hallo Heinz,
super, dass du es so hinbekommen hast. Mit meinem betagten EXCEL 97 hätte ich dir nur bedingt helfen können, da diese Version mit "Enum" bei den Deklarationen Probleme hat.
Gruß
Franz
AW: Rahmen über VBA
20.09.2006 22:30:09
Heinz
Hallo Franz
Was heisst hier "nur bedingt helfen können" !! Du bist doch derjenige gewesen der die ganze Arbeit verrichtet hat.
Mein beitun war nur ein Klacks gegen Deine Arbeit.
Nochmals recht herzlichen DANK und Gute Nacht,bis zum nächsten mal.
Gruss, Heinz

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige