Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema InputBox
BildScreenshot zu InputBox InputBox-Seite mit Beispielarbeitsmappe aufrufen

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"