Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1380to1384
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
Nur Rahmen und nur Füllfarbe kopieren
12.09.2014 12:02:31
Lutz
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

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Nur Rahmen und nur Füllfarbe kopieren
12.09.2014 12:42:36
yummi
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

Anzeige
AW: Nur Rahmen und nur Füllfarbe kopieren
12.09.2014 13:55:04
Lutz
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?

AW: Nur Rahmen und nur Füllfarbe kopieren
12.09.2014 14:06:23
yummi
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

Anzeige
AW: Nur Rahmen und nur Füllfarbe kopieren
12.09.2014 14:51:54
Lutz
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

Anzeige
AW: Nur Rahmen und nur Füllfarbe kopieren
12.09.2014 15:06:43
yummi
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

Anzeige
AW: Nur Rahmen und nur Füllfarbe kopieren
12.09.2014 15:28:16
Lutz
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

AW: Nur Rahmen und nur Füllfarbe kopieren
12.09.2014 17:13:47
yummi
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

Anzeige
AW: Nur Rahmen und nur Füllfarbe kopieren
12.09.2014 19:20:22
Lutz
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
Anzeige

304 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige