Live-Forum - Die aktuellen Beiträge
Datum
Titel
26.04.2024 21:51:33
Idee für Grafik
26.04.2024 21:29:07
PQ zufällige Reihenfolge
26.04.2024 17:18:47
Große Datenmenge in komplexes Diagramm verpacken
26.04.2024 16:22:47
Aktualisierung Verknüpfung bei geschlossener Quelldatei
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1808to1812
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1808to1812
1808to1812
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Borders Darstellung

Borders Darstellung
03.02.2021 18:33:13
anno
Hallo,
1. Problem: beim Einfuegen einer "leeren" Zeile eines Blattes in dasselbe Blatt mit ThisWorkbook.Worksheets(i).Rows(61).Copy
ThisWorkbook.Worksheets(i).Rows(i_Neu).Insert Shift:=xlDown
in einen anderen Zellbereich "verschwinden" die "ExcelOriginalen" GridLinien in der eingefuegten und in der nach unten verschobenen Zeile.
Dachte dann: "mach's selbst" und "testete" einige Varianten aus -> 2. Problem
Der Test bricht ab:
<img src="https://www.herber.de/bbs/user/143582.jpg" border="0">
<pre>Sub border3()
Dim i, i_Zl, i_Sp, i_Typ(1 To 3), j, i_TypF(1 To 3) As Integer
Dim s_Typ(1 To 3) As String
ThisWorkbook.Worksheets("Border3").Columns.Range("A:P").ColumnWidth = 10.71
ActiveSheet.Range("A1:P40").Borders.LineStyle = xlNone
ActiveSheet.Range("A1:P40").ClearContents
ActiveSheet.Range("A1:P40").Borders(xlDiagonalDown).LineStyle = xlNone
ActiveSheet.Range("A1:P40").Borders(xlDiagonalUp).LineStyle = xlNone
i_Typ(1) = 2 ' "xlThin"
i_Typ(2) = 1 ' "xlHairline"
i_Typ(3) = -4138 ' xlNone
s_Typ(1) = "xlThin"
s_Typ(2) = "xlHairline"
s_Typ(3) = "xlMedium"
i_TypF(1) = 15 ' HellGrau
i_TypF(2) = 24 ' HellLila
i_TypF(3) = 34 ' HellBlau
i_Zl = 8
i_Sp = 2
For j = 1 To 3 ' Farben
' xlLineStyleNone -4142 Keine Linie
' xlContinuous 1 Durchgehende Linie
For i = 1 To 3 ' LinienStaerke
ThisWorkbook.Worksheets("Border3").Columns(i_Sp - 1).ColumnWidth = 30
With ThisWorkbook.Worksheets("Border3").Range(ThisWorkbook.Worksheets("Border3").Cells(i_Zl, i_Sp), ThisWorkbook.Worksheets("Border3").Cells(i_Zl, i_Sp + 2)).Borders(xlDiagonalDown)
.LineStyle = xlLineStyleNone
' .LineStyle = xlContinuous ' <- beim 1. Durchlauf [ j=1; i=1 ] Fehler
' .ColorIndex = i_TypF(j) ' <- beim 7. Durchlauf [ j=3; i=1; wechsel von ColorIndex=24 auf ColorIndex=34 ] Fehler
' .Weight = i_Typ(i) ' <- beim 5. Durchlauf [ j=2; i=2; wechsel von xlThin auf xlHairline ] Fehler
End With
ThisWorkbook.Worksheets("Border3").Cells(i_Zl, i_Sp - 1).Value = "xlDiagonalDown " & s_Typ(i) & " F= " & i_TypF(j)
With ThisWorkbook.Worksheets("Border3").Range(ThisWorkbook.Worksheets("Border3").Cells(i_Zl + 1, i_Sp), ThisWorkbook.Worksheets("Border3").Cells(i_Zl + 1, i_Sp + 2)).Borders(xlDiagonalUp) '.Weight = i_Typ(i) ' xlThin
.LineStyle = xlLineStyleNone
' .LineStyle = xlContinuous ' <- beim 1. Durchlauf [ j=1; i=1 ] Fehler
' .ColorIndex = i_TypF(j) ' <- beim 7. Durchlauf [ j=3; i=1; wechsel von ColorIndex=24 auf ColorIndex=34 ] Fehler
' .Weight = i_Typ(i) ' <- beim 5. Durchlauf [ j=2; i=2; wechsel von xlThin auf xlHairline ] Fehler
End With
ThisWorkbook.Worksheets("Border3").Cells(i_Zl + 1, i_Sp - 1).Value = "xlDiagonalUp " & s_Typ(i) & " F= " & i_TypF(j)
With ThisWorkbook.Worksheets("Border3").Range(ThisWorkbook.Worksheets("Border3").Cells(i_Zl + 2, i_Sp), ThisWorkbook.Worksheets("Border3").Cells(i_Zl + 2, i_Sp + 2)).Borders(xlEdgeBottom) ' .Weight = i_Typ(i) ' xlThin
.LineStyle = xlLineStyleNone
' .LineStyle = xlContinuous ' <- beim 1. Durchlauf [ j=1; i=1 ] Fehler
' .ColorIndex = i_TypF(j) ' <- beim 7. Durchlauf [ j=3; i=1; wechsel von ColorIndex=24 auf ColorIndex=34 ] Fehler
' .Weight = i_Typ(i) ' <- beim 5. Durchlauf [ j=2; i=2; wechsel von xlThin auf xlHairline ] Fehler
End With
ThisWorkbook.Worksheets("Border3").Cells(i_Zl + 2, i_Sp - 1).Value = "xlEdgeBottom " & s_Typ(i) & " F= " & i_TypF(j)
With ThisWorkbook.Worksheets("Border3").Range(ThisWorkbook.Worksheets("Border3").Cells(i_Zl + 3, i_Sp), ThisWorkbook.Worksheets("Border3").Cells(i_Zl + 3, i_Sp + 2)).Borders(xlEdgeLeft) ' .Weight = i_Typ(i) ' xlThin
.LineStyle = xlLineStyleNone
' .LineStyle = xlContinuous ' <- beim 1. Durchlauf [ j=1; i=1 ] Fehler
' .ColorIndex = i_TypF(j) ' <- beim 7. Durchlauf [ j=3; i=1; wechsel von ColorIndex=24 auf ColorIndex=34 ] Fehler
' .Weight = i_Typ(i) ' <- beim 5. Durchlauf [ j=2; i=2; wechsel von xlThin auf xlHairline ] Fehler
End With
ThisWorkbook.Worksheets("Border3").Cells(i_Zl + 3, i_Sp - 1).Value = "xlEdgeLeft " & s_Typ(i) & " F= " & i_TypF(j)
With ThisWorkbook.Worksheets("Border3").Range(ThisWorkbook.Worksheets("Border3").Cells(i_Zl + 4, i_Sp), ThisWorkbook.Worksheets("Border3").Cells(i_Zl + 4, i_Sp + 2)).Borders(xlEdgeRight) '.Weight = i_Typ(i) ' xlThin
.LineStyle = xlLineStyleNone
' .LineStyle = xlContinuous ' <- beim 1. Durchlauf [ j=1; i=1 ] Fehler
' .ColorIndex = i_TypF(j) ' <- beim 7. Durchlauf [ j=3; i=1; wechsel von ColorIndex=24 auf ColorIndex=34 ] Fehler
' .Weight = i_Typ(i) ' <- beim 5. Durchlauf [ j=2; i=2; wechsel von xlThin auf xlHairline ] Fehler
End With
ThisWorkbook.Worksheets("Border3").Cells(i_Zl + 4, i_Sp - 1).Value = "xlEdgeRight " & s_Typ(i) & " F= " & i_TypF(j)
With ThisWorkbook.Worksheets("Border3").Range(ThisWorkbook.Worksheets("Border3").Cells(i_Zl + 5, i_Sp), ThisWorkbook.Worksheets("Border3").Cells(i_Zl + 5, i_Sp + 2)).Borders(xlEdgeTop) ' .Weight = i_Typ(i) ' xlThin
.LineStyle = xlLineStyleNone
' .LineStyle = xlContinuous ' <- beim 1. Durchlauf [ j=1; i=1 ] Fehler
' .ColorIndex = i_TypF(j) ' <- beim 7. Durchlauf [ j=3; i=1; wechsel von ColorIndex=24 auf ColorIndex=34 ] Fehler
' .Weight = i_Typ(i) ' <- beim 5. Durchlauf [ j=2; i=2; wechsel von xlThin auf xlHairline ] Fehler
End With
ThisWorkbook.Worksheets("Border3").Cells(i_Zl + 5, i_Sp - 1).Value = "xlEdgeTop " & s_Typ(i) & " F= " & i_TypF(j)
With ThisWorkbook.Worksheets("Border3").Range(ThisWorkbook.Worksheets("Border3").Cells(i_Zl + 6, i_Sp), ThisWorkbook.Worksheets("Border3").Cells(i_Zl + 7, i_Sp + 2)).Borders(xlInsideHorizontal) ' .Weight = i_Typ(i) ' xlThin
.LineStyle = xlLineStyleNone
' .LineStyle = xlContinuous ' <- beim 1. Durchlauf [ j=1; i=1 ] Fehler
' .ColorIndex = i_TypF(j) ' <- beim 7. Durchlauf [ j=3; i=1; wechsel von ColorIndex=24 auf ColorIndex=34 ] Fehler
' .Weight = i_Typ(i) ' <- beim 5. Durchlauf [ j=2; i=2; wechsel von xlThin auf xlHairline ] Fehler
End With
ActiveSheet.Cells(i_Zl + 6, i_Sp - 1).Value = "xlInsideHorizontal " & s_Typ(i) & " F= " & i_TypF(j)
With ThisWorkbook.Worksheets("Border3").Range(ThisWorkbook.Worksheets("Border3").Cells(i_Zl + 8, i_Sp), ThisWorkbook.Worksheets("Border3").Cells(i_Zl + 8, i_Sp + 2)).Borders(xlInsideVertical) ' .Weight = i_Typ(i) ' xlThin
.LineStyle = xlLineStyleNone
' .LineStyle = xlContinuous ' <- beim 1. Durchlauf [ j=1; i=1 ] Fehler
' .ColorIndex = i_TypF(j) ' <- beim 7. Durchlauf [ j=3; i=1; wechsel von ColorIndex=24 auf ColorIndex=34 ] Fehler
' .Weight = i_Typ(i) ' <- beim 5. Durchlauf [ j=2; i=2; wechsel von xlThin auf xlHairline ] Fehler
End With
ActiveSheet.Cells(i_Zl + 8, i_Sp - 1).Value = "xlInsideVertical " & s_Typ(i) & " F= " & i_TypF(j)
' i_Zl = 8
i_Sp = i_Sp + 5
Next i
Debug.Print
i_Zl = i_Zl + 10
i_Sp = 2
Next j
End <pre>Sub ' border3
Trotz Suche in Foren: habe keine Loesung(en) gefunden.
Bitte - wenn moeglich - um Info
Gruß
anno

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Borders Darstellung
03.02.2021 20:56:49
fcs
Hallo Anno,
das sollte eigentlich funktionieren
Allerdings muss der Wert der Variablen i_Neu dabei größer als 61 sein, da sich sonst die Zeile 61 nach unten verschiebt und beim nächsten Kopiervorgang ggf.eine Zeile ohne bzw. mit nicht allen Rahmen kopiert wird.
LG
Franz
Mein Testmakro: 
Sub Test()
Dim i, i_Neu
i = 1
i_Neu = 64
ThisWorkbook.Worksheets(i).Rows(61).Copy
ThisWorkbook.Worksheets(i).Rows(i_Neu).Insert Shift:=xlDown
End Sub

AW: Borders Darstellung
03.02.2021 21:04:26
anno
Hallo Franz,
und Dank für deine Antwort!
Das Kopieren an sich funktioniert.
Ja, nachdem die Zeile eingefuegt wurde loesch ich einfach eine andere leere Zeile dazwischen.
So verbleibt die leere "MusterZeile" immer an der gleichen Nummerierung.
Aber: das Problem besteht in den "Gridlines", die nach dem einfuegen und dem versetzen der Zeile, die an der Einfuegeposition war nach unten, dann auch keine Gridlines ( die von Excel ) mehr hat.
Deshalb will ich selbst ueber vba - mit Borders - "Gridlines" erzeugen.
Ein Test um die Parameter herauszufinden schlägt jedoch fehl ( excelsheet und ErgebnisBild in erster Anfrage ).
Warum dies fehlschlägt: ?
Bevor ich da Borders selbst erzeuge muss ich Wissen woran der Test gescheitert ist.
Gruß
anno
Anzeige
AW: Borders Darstellung
03.02.2021 23:47:58
fcs
Hallo Anno,
in deiner Anfrage fehlt der Link zum Excel-Sheet und die eingebundene Grafik funktioniert nicht. Im Forum werden Grafiken normalerweise direkt dargestellt.
Ich hab einer Datei mal das Makro eingebaut und aufbereitet. Warum es bei dir nicht funktioniert weiß ich nicht.
Zusätzlich habe ich eine programmiertechnisch optimierte Version des Makros erstellt.
LG
Franz
https://www.herber.de/bbs/user/143593.xlsm
AW: Borders Darstellung
05.02.2021 13:14:22
anno
Hallo Franz,
konnte es leider erst heute austesten...
funktioniert SUPER! Vielen Dank!
Gruß
anno
Aber auch: Dank an Luc:-? und Tobias fuer eure Hilfe!
Anzeige
AW: Borders Darstellung
05.02.2021 13:34:42
Hajo_Zi
offen bedeutet es soll noch eine Antwort kommen.
Warum ist dein Beitrag Offen.
Du willst doch was machen. Soll jemand vorbei kommen?
Das ist nur meine Meinung zu dem Thema.

AW: Borders Darstellung
03.02.2021 22:09:16
Tobias
Hallo Anno,
es gibt die CopyOrigin Funktion die kannst du hinter deinen Shift befehlt beim Insert setzen 
ThisWorkbook.Worksheets(i).Rows(i_Neu).Insert Shift:=xlDown CopyOrigin:=xlFormatFromLeftOrAbove
Hilft das vielleicht schon? Dein Problem konnte ich nicht nachstellen.
Schönen Gruß
Tobias

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige