Nur Rahmen und nur Füllfarbe kopieren
Betrifft: Nur Rahmen und nur Füllfarbe kopieren
von: Lutz
Geschrieben am: 12.09.2014 12:02:31
Hallo Excel-Profis,
nach langer Zeit mal wieder ein Problem bei dem ich auch mit Google nicht weiterkomme.
Ich muss in einer bestehenden Datei viele Bereiche kopieren und anpassen.
Nun muss ich einmal nur die vorhandenen Rahmen kopieren (kein Inhalt, keine weiteren Formatierungen – nur die Rahmeneinstellung).
Und dann muss ich einmal nur die vorhandene Füllfarbe kopieren – nichts weiter nur die Füllfarbe.
Ich habe ein Makro im Einsatz mit dem ich nur die Formeln kopiere:
Sub copy_Formula()
Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:= _
False
Application.CutCopyMode = False
End Sub
Kann man das mit den Rahmen und der Füllfarbe auch in der Form machen?
Ich würde gerne einen Bereich markieren und mit strg+c kopieren und dann auf den Zielbereich gehen und das Makro ausführen welches mir dann mit Makro1 nur den Rahmen und mit Makro2 nur die Füllfarbe kopiert.
Vielen Dank für Eure Hilfe und ein schönes Wochenende
Viele Grüße Lutz
Betrifft: AW: Nur Rahmen und nur Füllfarbe kopieren
von: yummi
Geschrieben am: 12.09.2014 12:42:36
Hallo Lutz,
einmal mit Testaufruf dazu
Option Explicit
Function Set_BordersAndColor(rngSource As Range, rngdest As Range)
Dim i As Integer
For i = 7 To 10
With rngdest.Borders(i)
.LineStyle = rngSource.Borders(i).LineStyle
.Weight = rngSource.Borders(i).Weight
.Color = rngSource.Borders(i).Color
End With
rngdest.Interior.Color = rngSource.Interior.Color
Next
End Function
Sub test()
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = ActiveSheet.Cells(3, 2)
Set rng2 = ActiveSheet.Cells(3, 5)
Call Set_BordersAndColor(rng1, rng2)
End Sub
Gruß
yummi
Betrifft: AW: Nur Rahmen und nur Füllfarbe kopieren
von: Lutz
Geschrieben am: 12.09.2014 13:55:04
Hallo Yummi,
vielen Dank, er überträgt von B3 nach E3 die Füllfarbe. Das ist aber eine recht limitierte Sache - ich müßte ja immer in den Code schreiben von wo nach wo.
Vielleicht bekommt man es aus dem Zwischenspeicher nicht hin, dann muß man vielleicht 2 Makros nehmen:
1. In dem Bereich aus dem die Füllfarbe kommen soll
2. Bereich markieren in das die Füllfarbe rein soll
Damit kann man ja auch leben aber ich weiß nicht wie man das in VBA macht - Du?
Vielen Dank und viele Grüße Lutz
Geht das bei den Rahmen auch auf diesem Wege?
 |
Betrifft: AW: Nur Rahmen und nur Füllfarbe kopieren
von: yummi
Geschrieben am: 12.09.2014 14:06:23
Hallo Lutz,
ich hab dir doch die funktion genau dafür gegeben.
du übergibst an die funktion den Bereich von wo du kopieren willst rngSource
und wohin du kopieren willst rngdest
Den Rest macht die Funktion
In Sub Test kannst Du sehen wie Du das aufrufen kannst, am Beispiel von B3 nach E3, du kannst das aber auch mit jedem anderen Bereich machen.
Oder wolltest Du das über Formeln lösen (wenn das überhaupt geht)
Gruß
yummi
 |
Betrifft: AW: Nur Rahmen und nur Füllfarbe kopieren
von: Lutz
Geschrieben am: 12.09.2014 14:51:54
Hallo Yummi,
sorry vielleicht verstehe ich das nicht richtig:
Das Makro von Dir kopiert von Zelle B3 nach E3 die Farbe und den Rahmen?!
(Die Farbe geht, ich habe es mal in B3 mit gelber Füllung und nur mit einem Rahmen unten versucht - die Farbe überträgt er aber er zieht dann in E3 einen kompletten Rahmen um die Zelle).
Für meine Fälle müsste man das etwas neutraler halten: ich kopiere eine Zelle mit einer Formatierung (erstes Makros - die Funktion liest das aus); dann markiere ich eine 2te Zelle/Bereich und aktiviere das 2te Makro das dann das gemerkte Format.
Viele Grüße Lutz
Betrifft: AW: Nur Rahmen und nur Füllfarbe kopieren
von: yummi
Geschrieben am: 12.09.2014 15:06:43
Hallo Lutz,
jetzt passt der Rahmen
Function Set_BordersAndColor(rngSource As Range, rngdest As Range)
Dim i As Integer
For i = 7 To 10
With rngdest.Borders(i)
If rngSource.Borders(i).LineStyle <> xlNone Then
.LineStyle = rngSource.Borders(i).LineStyle
.Weight = rngSource.Borders(i).Weight
.Color = rngSource.Borders(i).Color
End If
End With
rngdest.Interior.Color = rngSource.Interior.Color
Next
End Function
Sub test()
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = ActiveSheet.Cells(3, 2)
Set rng2 = ActiveSheet.Cells(3, 5)
Call Set_BordersAndColor(rng1, rng2)
End Sub
Die aufrufe wann du was kopieren willst kannst du doch ganz variabel gestalten.
Gruß
yummi
Betrifft: AW: Nur Rahmen und nur Füllfarbe kopieren
von: Lutz
Geschrieben am: 12.09.2014 15:28:16
Hallo Yummi,
vielen Dank - das mit dem Rahmen geht, aber nur wenn in der Zielzelle noch kein Rahmen ist. Wenn die Quellezelle nur einen Rahmen unten hat und die Zielzelle bisher einen kompletten Rahmen dann bleibt es bei einem kompletten Rahmen. Hatte die Zielelle noch keinen Rahmen wird auch nur der Rahmen unten übernommen.
Mein Problem ist ja dass ich micht nicht mit VBA auskenne - sonst würde ich mir das selber schreiben. Wie würde denn die Trennung in Wegspeichern und Übertragen gehen?
Vielen Dank für Deine Geduld und viele Grüße Lutz
Betrifft: AW: Nur Rahmen und nur Füllfarbe kopieren
von: yummi
Geschrieben am: 12.09.2014 17:13:47
Hallo Lutz,
Function Set_BordersAndColor(rngSource As Range, rngdest As Range)
Dim i As Integer
For i = 7 To 10
With rngdest.Borders(i)
.LineStyle = xlNone 'hier löscht Du den Rahmen der Zielzelle erst ab
If rngSource.Borders(i).LineStyle <> xlNone Then
.LineStyle = rngSource.Borders(i).LineStyle
.Weight = rngSource.Borders(i).Weight
.Color = rngSource.Borders(i).Color
End If
End With
rngdest.Interior.Color = rngSource.Interior.Color
Next
End Function
Sub test()
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = ActiveSheet.Cells(3, 2)
Set rng2 = ActiveSheet.Cells(3, 5)
Call Set_BordersAndColor(rng1, rng2) 'so einen Aufruf mit den Zellen die Du benötigst _
baust Du in dein Makro ein.
End Sub
Gruß
yummi
Betrifft: AW: Nur Rahmen und nur Füllfarbe kopieren
von: Lutz
Geschrieben am: 12.09.2014 19:20:22
Hallo Yummi,
vielen lieben Dank, ich habe es jetzt so gelöst:
Function Set_BordersAndColor(rngSource As Range, rngdest As Range)
Dim i As Integer
For i = 7 To 10
With rngdest.Borders(i)
.LineStyle = xlNone 'hier löscht Du den Rahmen der Zielzelle erst ab
If rngSource.Borders(i).LineStyle <> xlNone Then
.LineStyle = rngSource.Borders(i).LineStyle
.Weight = rngSource.Borders(i).Weight
.Color = rngSource.Borders(i).Color
End If
End With
rngdest.Interior.Color = rngSource.Interior.Color
Next
End Function
Function Set_Borders(rngSource As Range, rngdest As Range)
Dim i As Integer
For i = 7 To 10
With rngdest.Borders(i)
.LineStyle = xlNone 'hier löscht Du den Rahmen der Zielzelle erst ab
If rngSource.Borders(i).LineStyle <> xlNone Then
.LineStyle = rngSource.Borders(i).LineStyle
.Weight = rngSource.Borders(i).Weight
.Color = rngSource.Borders(i).Color
End If
End With
Next
End Function
Function Set_Color(rngSource As Range, rngdest As Range)
rngdest.Interior.Color = rngSource.Interior.Color
End Function
Sub test()
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = ActiveSheet.Cells(3, 2)
Set rng2 = ActiveSheet.Cells(3, 5)
Call Set_BordersAndColor(rng1, rng2) 'so einen Aufruf mit den Zellen die Du benötigst _
baust Du in dein Makro ein.
End Sub
Sub AtestBaC()
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = ActiveCell
Set rng2 = Application.InputBox("Select a range", "Get Range", Type:=8)
Call Set_BordersAndColor(rng1, rng2)
End Sub
Sub AtestB()
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = ActiveCell
Set rng2 = Application.InputBox("Select a range", "Get Range", Type:=8)
Call Set_Borders(rng1, rng2)
End Sub
Sub AtestC()
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = ActiveCell
Set rng2 = Application.InputBox("Select a range", "Get Range", Type:=8)
Call Set_Color(rng1, rng2)
End Sub
Man steht dann schon in der Quellzelle und wählt den Zielbereich aus.
Und ich habe mal getrennt in Rahmen und Farbe, nur Farbe und Rahmen.
Also vielen lieben Dank und noch ein schönes Wochenende,
viele Grüße Lutz
Beiträge aus den Excel-Beispielen zum Thema "Nur Rahmen und nur Füllfarbe kopieren"