Makros für Button und Dropdown-Menu

[WillWissen]

Hi André,

das hatte ich per PN gesendet …

die halt keiner außer den beiden Beteiligten kennt.

[schauan]

… die sende ich auch immer an den user admins … An jeden einzelnen sollte ich ja nicht mehr ...

[Bud]

Hey nochmal,

ich habe jetzt den Thread bei herber beendet und auf diesen hier verwiesen, um weiteres Crossposting zu vermeiden.

Mir ist es leider nicht gelungen einen richtigen Code für das Auslesen der Dropdown-Zelle bei Aktivierung des Speicher-Buttons einzufügen,
damit das jeweilige Makro zu aktivieren und bei fehlender Eingabe die Aktivierung zu verhindern (+message box)

Sollte sich da noch jemand die Mühe machen wollen das zu tun würde ich mich freuen, da es mir nicht gelingen will.
Aber auch mit der jetzigen Lösung kann ich arbeiten, wenn auch etwas weniger elegant


Das Dropdown Menu habe ich entfernt und für die beiden Eingabe-Typen jeweils eine Zeile erstellt
und dem jeweiligen Button je ein Makro zugeordnet. Zudem jeweils eine Berechnung der voraussichtlichen Dauer
anhand der Mittelwerte aus den letzten fünf gespeicherten Einträgen der jeweilgigen Typen Abruf / Archivierung erstellt.

Gerne biete ich mein (evtl. vorläufiges) Ergebnis an, falls dies jemandem weiterhelfen sollte:


  UebertragungsrateVorschau.xlsm (Größe: 32,18 KB / Downloads: 4)

Danke für die schnelle und geduldige Hilfe an alle Beteiligten.

Alles Gute,
Bud

[schauan]

Hallöchen,

Hie rmal als Beispiel eine mögliche Vorgehensweise beim Programmieren. Der aufgezeichnete Code nach meinem Vorschlag sieht erst mal so aus:

Code:

Sub Makro2()
'
' Makro2 Makro
'

'
    Sheets("Abruf").Select
    Range("A9:J49").Select
    Selection.Copy
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    ActiveWindow.SmallScroll Down:=-33
    Range("A10").Select
    ActiveSheet.Paste
    Range("A6:J6").Select
    Selection.Copy
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Range("A9").Select
    ActiveSheet.Paste
    ActiveWindow.SmallScroll Down:=-9
    Range("A2:J5").Select
    Application.CutCopyMode = False
    Selection.Copy
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Range("A3").Select
    ActiveSheet.Paste
    Sheets("Rechner").Select
    Range("A3:J3").Select
    Selection.Copy
    Sheets("Abruf").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Sheets("Rechner").Select
    Application.CutCopyMode = False
End Sub

Scrollen muss man nicht, wenn man ein Makro ausführt, das hab ich rausgenommen

Code:

Sub Makro2()
    Sheets("Abruf").Select
    Range("A9:J49").Select
    Selection.Copy
    Range("A10").Select
    ActiveSheet.Paste
    Range("A6:J6").Select
    Selection.Copy
    Range("A9").Select
    ActiveSheet.Paste
    Range("A2:J5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("A3").Select
    ActiveSheet.Paste
    Sheets("Rechner").Select
    Range("A3:J3").Select
    Selection.Copy
    Sheets("Abruf").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Sheets("Rechner").Select
    Application.CutCopyMode = False
End Sub

Dann hab ich noch das Select beim Kopieren und Einfügen reduziert und Kommentare zur Beschreibung eingefügt. Die Selects kann man übrigens noch weiter minimieren. Das ist jetzt auch noch nicht flexibel auf Abruf oder Archivierung eingestellt und berücksichtigt Deine Zeile 50 als letzte Zeile aus dem Anfangspost. Probier's mal aus, dann schauen wir weiter.

Code:

Sub Makro2()
'Auf das Abrufblatt wechseln
Sheets("Abruf").Select
'unteren Bereich um eine Zeile nach unten versetzen
Range("A9:J49").Copy Range("A10")
'letzte Zeile des oberen Bereichs als erste Zeile im unteren Bereich einsetzen
Range("A6:J6").Copy Range("A9")
'oberen Bereich um eine Zeile nach unten versetzen
Range("A2:J5").Copy Range("A3")
'Daten aus Eingabezeile im Blatt Rechner holen
'Ins Blatt rechner wechseln
Sheets("Rechner").Select
'Daten kopieren
Range("A3:J3").Copy
'Ins Blatt Abruf wechseln
Sheets("Abruf").Select
'A2 waehlen
Range("A2").Select
'Werte einfuegen
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
'Formate einfuegen
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
'Ins Blatt rechner wechseln
Sheets("Rechner").Select
'Lopiermodus ausschalten
Application.CutCopyMode = False
End Sub

[Bud]

Danke nochmal, für die Tipps.

Ich werde die Codes dann noch dahingehend optimieren.
So dass die beim Aufzeichnen entstandenen, für das Makro aber unnötigen Schritte entfernt werden.

Dafür werde ich heute aber die Zeit nicht mehr finden.

Generell hat aber ein Makro nicht funktioniert, also lade ich die überarbeitete, funktionierende Datei hoch, für jenen den es nützen möge:


  UebertragungsrateVorschau.xlsm (Größe: 33,47 KB / Downloads: 3)


Bis dahin,

Bud