Microsoft Excel

Herbers Excel/VBA-Archiv

Makros zusammenfügen

Betrifft: Makros zusammenfügen von: Tom
Geschrieben am: 14.08.2008 10:40:18

Hallo,

ich habe folgende u.a. Codes. Ich möchte nun, dass diese Codes als ein Makro ablaufen. Aber nicht als Worksheet_Activate sondern nach Betätigung eines Buttons (MAkro zuweisen). Da ich in VBA nicht der Held bin und mir diese Codes zusammengebastelt habe, benötige ich die Hilfe von Profis :-)

1) Sobald Tabellenblatt aktiviert wird, wird die Tabelle nach Spalte B sortiert

Private Sub Worksheet_Activate() ' CODE STEHT IN Tabelle1
Cells.Select
    Cells.EntireRow.AutoFit
Range("A5:F741").Select
    Selection.Sort Key1:=Range("B6"), Order1:=xlAscending, Key2:=Range("A6") _
        , Order2:=xlAscending, Key3:=Range("C6"), Order3:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A6").Select
End Sub



2) In Spalte B stehen verschiedene Fachabteilungen. Nach dem Sortieren wird hier nun ein roter Rahmen gezogen, um die Abteilungen auch optisch voneinander zu trennen:

Private Sub Worksheet_Change(ByVal Target As Range)  ' CODE STEHT IN Tabelle1
If Target.Column = 2 Then
  On Error GoTo errHandler
  Application.EnableEvents = False
  Rahmen_Check
End If
errHandler:
  Application.EnableEvents = True
End Sub



Sub Rahmen_Check() ' CODE STEHT IN MODUL1
Dim c As Range, Ctmp As Range
For Each c In Range(Cells(6, 2), Cells(6, 2).End(xlDown)).SpecialCells(xlCellTypeVisible)
With Range(c.Offset(0, -1), c.Offset(0, 4))
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
If Not Ctmp Is Nothing Then
If c <> Ctmp Then
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick 'fett
.ColorIndex = 3 'rot
End With
Else
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End If
End If
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
Set Ctmp = c
Next c
Set c = Cells(65536, 2).End(xlUp)
With Range(c.Offset(0, -1), c.Offset(0, 4))
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick 'fett
.ColorIndex = 3 'rot
End With
End With
End Sub



Danke vorab

TOM

  

Betrifft: AW: Makros zusammenfügen von: {mskro}
Geschrieben am: 14.08.2008 10:47:13

Hallo Tom,

Sub 2Makros()
Makro1
Makro2
End Sub



Gruß Manfred


  

Betrifft: AW: Makros zusammenfügen von: Tom
Geschrieben am: 14.08.2008 11:02:47

Hallo Manfred,

ich dachte auch, dass dies so einfach ist - aber leider kommt immer ne Fehlermeldung, da der eine Code bei Blattaktivierung gestartet wird und der andere manuell...

Wie muss ich welchen Code zusammenbasteln? Hast Du mir ne Lösung?

Gruß
TOM


  

Betrifft: AW: Makros zusammenfügen von: Hajo_Zi
Geschrieben am: 14.08.2008 11:08:15

Hallo Tom,

das liest sich so als ob Du das Ereignis Private Sub Worksheet_Activate() benutzt. In Deinen Makro dürfen keine Select auf andere Tabellen enthalten sein.

GrußformelHomepage


  

Betrifft: AW: Makros zusammenfügen von: Tom
Geschrieben am: 14.08.2008 11:26:17

Hallo Hajo,

anbei mal die Datei, dann wird es sicherlich leichter für Euch:

https://www.herber.de/bbs/user/54597.xls


Gruß
TOM


  

Betrifft: AW: Makros zusammenfügen von: Hajo_Zi
Geschrieben am: 14.08.2008 11:30:08

Hallo Tom,

ich würde das Makro wie folgt ändern

Private Sub Worksheet_Activate()
    Cells.EntireRow.AutoFit
    Range("A5:F741").Sort Key1:=Range("B6"), Order1:=xlAscending, Key2:=Range("A6") _
            , Order2:=xlAscending, Key3:=Range("C6"), Order3:=xlAscending, Header:= _
            xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub



Gruß Hajo


  

Betrifft: AW: Makros zusammenfügen von: Tom
Geschrieben am: 14.08.2008 11:43:36

Hallo Hajo,

ich möchte das Makro aber nicht über Private Sub Worksheet_Activate() aufrufen, weil die Tabelle nun in einer einzelnen Datei steht.

Ich möchte mit dem Klick auf den Smilie Sortieren und den Rahmen hinzufügen

Ist das möglich?

Gruß
TOM


  

Betrifft: AW: Makros zusammenfügen von: Hajo_Zi
Geschrieben am: 14.08.2008 11:46:43

Hallo Tom,

dann kopiere die Zeilen doch in das Makro.

Gruß Hajo


  

Betrifft: AW: Makros zusammenfügen von: Tom
Geschrieben am: 14.08.2008 11:57:34

Hallo Hajo,

sorry-ich stand total auf der Leitung ... Jetzt funktioniert es.

Allerdings läuft das Makro für 560 Zeilen fast 2 Minuten - kann man das verkürzen?

Gruß
TOM


  

Betrifft: AW: Makros zusammenfügen von: Daniel
Geschrieben am: 14.08.2008 12:42:09

Hi
ich würde die roten Rahmen nicht per Makro, sondern ber Bedingter Formatierung setzen:

Zellbereich unterhalb der Überschrift markieren und folgende formel eingeben:
=$B6<>$B7
und dann unter Format-Rand den unteren Rand in Rot auswählen

da du schon eine Bedingtes Format hast, brauchst du dann eben alle 3
1. Bedingung: Roter Rand und Durchgestrichen
2. Bedingung: Durchgestrichen
3. Bedingung: Roter Rand

Gruß, Daniel


  

Betrifft: AW: Makros zusammenfügen von: Tom
Geschrieben am: 14.08.2008 14:21:27

Hi Daniel,

super Idee und klappt auch wunderbar.
Kann ich den Rahmen auch fetter darstellen? Irgendwie geht bei mir nur der "dünne" ...

Gruß
TOM


  

Betrifft: AW: Makros zusammenfügen von: Daniel
Geschrieben am: 14.08.2008 14:37:25

Hi
nö, geht nicht.
haben BillyBoy und sein Kumpel Steve (noch) nicht vorgesehen.
einen Tod muss man sterben.
du musst halt die andern Rahmen drum herum dünner machen.
Gruß, Daniel


  

Betrifft: AW: Makros zusammenfügen von: Tom
Geschrieben am: 14.08.2008 14:38:12

Alles klar, trotzdem vielen Dank an alle!!!!


 

Beiträge aus den Excel-Beispielen zum Thema "Makros zusammenfügen"