Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
816to820
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
816to820
816to820
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Makro von einer anderen Userform ausführen

Makro von einer anderen Userform ausführen
06.11.2006 13:41:00
einer
Hi zusammen,
ich habe da ein kleines Problem. Ich habe mehrere Userformen und ich möchte gerne, das ich mit einem Button der sich z.B. auf Userform1 befindet, ein Makro auf Userform2 aktivieren. Kommt man mit dem Befehl "call" da weiter?
Gruß Pascal

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro von einer anderen Userform ausführen
06.11.2006 13:47:14
einer
Hallo,
poste mal den Gesamtem Code des aufzurufenden Makros.
Prinzipiell geht es, wenn das Makro nicht Private ist, mit Call.
Gruß K.Rola
AW: Makro von einer anderen Userform ausführen
06.11.2006 14:27:03
einer
Hi K.Rola,
der Code ist einwenig lang. Und auf einer anderen Userform befindet sich ein Button, der genau das gleiche ausführen soll. Momentan habe ich hinter beiden Buttons den selben Code hinterlegt. Unterschied besteht nur das bei dem zweiten Button noch ein paar andere Aktionen laufen:
Gruß Pascal

Private Sub CommandButton38_Click()
Dim Zelle As Range
Dim bereich As Range
Dim Markierung As Range, Wert As String
Dim Leerspalten As Integer
Dim mySpalte As Integer
Dim iSpalte As Integer
Application.ScreenUpdating = False
On Error Resume Next
Workbooks.Open Filename:= _
"F:\FIB\sonstiges\KTR\Auswertung KTR.xls"
ChDir "F:\FIB\sonstiges\KTR"
ActiveWorkbook.SaveAs Filename:= _
"F:\FIB\sonstiges\KTR\Auswertung KTR - " & Date$ & ".xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Application.DisplayAlerts = False
Worksheets("Tabelle1").Delete
Application.DisplayAlerts = True
On Error Resume Next
Sheets.Add.Name = "Übersicht"
'Kopieren in Übersicht
'Spalte A GK-Zuschlagsätze
Application.Range("Übersicht!a1").Value = "Systemgruppe"
Application.Range("Übersicht!a2").Value = "Produktgruppe"
Application.Range("Übersicht!a3").Value = "Artikelgruppe"
Application.Range("Übersicht!a4").Value = "Bezeichnung"
Application.Range("Übersicht!a5").Value = "Händler EK"
Application.Range("Übersicht!a6").Value = "MEK 1"
Application.Range("Übersicht!a7").Value = "'./. Skonto"
Application.Range("Übersicht!a8").Value = "'= MEK"
Application.Range("Übersicht!a9").Value = "'./. Bonus v. MEK 1"
Application.Range("Übersicht!a10").Value = "'= MEK"
Application.Range("Übersicht!a11").Value = "'+ EGK"
Application.Range("Übersicht!a12").Value = "'+ LGK"
Application.Range("Übersicht!a13").Value = "'+ RGK"
Application.Range("Übersicht!a14").Value = "'= Herstellkosten"
Application.Range("Übersicht!a15").Value = "'+ VtGK"
Application.Range("Übersicht!a16").Value = "'+ VwGK"
Application.Range("Übersicht!a17").Value = "'+ Abschreibung Ware"
Application.Range("Übersicht!a18").Value = "'= Selbstkosten"
Application.Range("Übersicht!a19").Value = "'+ Gewinnzuschlag"
Application.Range("Übersicht!a20").Value = "'= Barverkaufspreis"
Application.Range("Übersicht!a21").Value = "'+ Bonus"
Application.Range("Übersicht!a22").Value = "'+ Skonto"
Application.Range("Übersicht!a23").Value = "'= Zielverkaufspreis"
Application.Range("Übersicht!a24").Value = "'+ Rabatt"
Application.Range("Übersicht!a25").Value = "'= Nettoverkaufspreis"
Application.Range("Übersicht!a27").Value = "Gewinn in Prozent "
Application.Range("Übersicht!a29").Value = "VK - Stück"
Application.Range("Übersicht!a31").Value = "Gewinn / Artikelgruppe"
'Spalte A pauschale GK
Application.Range("Übersicht!a35").Value = "Systemgruppe"
Application.Range("Übersicht!a36").Value = "Produktgruppe"
Application.Range("Übersicht!a37").Value = "Artikelgruppe"
Application.Range("Übersicht!a38").Value = "Bezeichnung"
Application.Range("Übersicht!a39").Value = "Händler EK"
Application.Range("Übersicht!a40").Value = "MEK 1"
Application.Range("Übersicht!a41").Value = "'./. Skonto"
Application.Range("Übersicht!a42").Value = "'= MEK"
Application.Range("Übersicht!a43").Value = "'./. Bonus v. MEK 1"
Application.Range("Übersicht!a44").Value = "'= MEK"
Application.Range("Übersicht!a45").Value = "'+ pauschale GK"
Application.Range("Übersicht!a46").Value = "'+ Abschreibung"
Application.Range("Übersicht!a47").Value = "'= Selbstkosten"
Application.Range("Übersicht!a48").Value = "'+ Gewinnzuschlag"
Application.Range("Übersicht!a49").Value = "'= Barverkaufspreis"
Application.Range("Übersicht!a50").Value = "'+ Bonus"
Application.Range("Übersicht!a51").Value = "'+ Skonto"
Application.Range("Übersicht!a52").Value = "'= Zielverkaufspreis"
Application.Range("Übersicht!a53").Value = "'+ Rabatt"
Application.Range("Übersicht!a54").Value = "'= Nettoverkaufspreis"
Application.Range("Übersicht!a56").Value = "Gewinn in Prozent"
Application.Range("Übersicht!a58").Value = "VK - Stück"
Application.Range("Übersicht!a60").Value = "Gewinn / Artikelgruppe"
Application.Range("Übersicht!a64").Value = "EK-Skonto / -Bonus fallen"
Application.Range("Übersicht!a65").Value = "bei Aktionsware nicht an"
'Spalte B GK-Zuschlagsätze
Application.Range("Übersicht!b6").Value = "'%"
Application.Range("Übersicht!b7").Value = Range("[Kostenträgerrechnung]Dateneingabe!F25")
Application.Range("Übersicht!b9").Value = Range("[Kostenträgerrechnung]Dateneingabe!F26")
Application.Range("Übersicht!b11").Value = Range("[Kostenträgerrechnung]Dateneingabe!E19")
Application.Range("Übersicht!b12").Value = Range("[Kostenträgerrechnung]Dateneingabe!F19")
Application.Range("Übersicht!b13").Value = Range("[Kostenträgerrechnung]Dateneingabe!G19")
Application.Range("Übersicht!b15").Value = Range("[Kostenträgerrechnung]Dateneingabe!H19")
Application.Range("Übersicht!b16").Value = Range("[Kostenträgerrechnung]Dateneingabe!I19")
Application.Range("Übersicht!b21").Value = Range("[Kostenträgerrechnung]Dateneingabe!F30")
Application.Range("Übersicht!b22").Value = Range("[Kostenträgerrechnung]Dateneingabe!F29")
Application.Range("Übersicht!b24").Value = Range("[Kostenträgerrechnung]Dateneingabe!F31")
'Spalte B pauschale GK
Application.Range("Übersicht!b40").Value = "'%"
Application.Range("Übersicht!b41").Value = Range("[Kostenträgerrechnung]Dateneingabe!F25")
Application.Range("Übersicht!b43").Value = Range("[Kostenträgerrechnung]Dateneingabe!F26")
Application.Range("Übersicht!b50").Value = Range("[Kostenträgerrechnung]Dateneingabe!F30")
Application.Range("Übersicht!b51").Value = Range("[Kostenträgerrechnung]Dateneingabe!F29")
Application.Range("Übersicht!b53").Value = Range("[Kostenträgerrechnung]Dateneingabe!F31")
'Spalte C GK-Zuschlagsätze
Application.ScreenUpdating = False
Worksheets("15999").Range("c1:c31").Copy
Worksheets("Übersicht").Range("c1:c31").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, skipBlanks:=False, Transpose:=False
'Spalte C pauschale GK
Application.ScreenUpdating = False
Worksheets("15999").Range("g1:g26").Copy
Worksheets("Übersicht").Range("c35:c60").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, skipBlanks:=False, Transpose:=False
'Spalte D GK-Zuschlagsätze
Application.ScreenUpdating = False
Worksheets("16999").Range("c1:c31").Copy
Worksheets("Übersicht").Range("d1:d31").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, skipBlanks:=False, Transpose:=False
'Spalte D pasuschale GK
Application.ScreenUpdating = False
Worksheets("16999").Range("g1:g26").Copy
Worksheets("Übersicht").Range("d35:d60").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, skipBlanks:=False, Transpose:=False
'Löschen der nicht relevanten Zahlen
If Not Range("Übersicht!c3").Value = 15999 Then Columns("C:C").EntireColumn.ClearContents
If Not Range("Übersicht!d3").Value = 16999 Then Columns("D:D").EntireColumn.ClearContents
'Fettdruck in Tabelle "Übersicht"
Range("a1:ac3").Font.Bold = True
Range("a35:ac37").Font.Bold = True
Range("a10:ac10").Font.Bold = True
Range("a44:ac44").Font.Bold = True
Range("a14:ac14").Font.Bold = True
Range("a18:ac18").Font.Bold = True
Range("a47:ac47").Font.Bold = True
Range("a20:ac20").Font.Bold = True
Range("a49:ac49").Font.Bold = True
Range("a23:ac23").Font.Bold = True
Range("a52:ac52").Font.Bold = True
Range("a25:ac25").Font.Bold = True
Range("a54.ac54").Font.Bold = True
Range("a31:ac31").Font.Bold = True
Range("a60:ac60").Font.Bold = True
'"Gewinn"-Zeile schwarz
Range("a19:ac19").Interior.ColorIndex = 1
Range("a48:ac48").Interior.ColorIndex = 1
Range("a31:ac31").Interior.ColorIndex = 1
Range("a60:ac60").Interior.ColorIndex = 1
'"Gewinn"-Zeile Schrift weiss
Range("a19:ac19").Font.ColorIndex = 2
Range("a48:ac48").Font.ColorIndex = 2
Range("a60:ac60").Font.ColorIndex = 2
Range("a31:ac31").Font.ColorIndex = 2
'Zellen in grau färben
Range("a1:b18").Interior.ColorIndex = 15
Range("a35:b47").Interior.ColorIndex = 15
Range("a20:b30").Interior.ColorIndex = 15
Range("a49:b59").Interior.ColorIndex = 15
Range("c1:ac5").Interior.ColorIndex = 15
Range("c35:ac39").Interior.ColorIndex = 15
'Zellen zentrieren
Range("b1:ac60").HorizontalAlignment = xlCenter
'Schriftgrösse
Range("a1:ac5").Font.Size = 12
Range("a35:ac39").Font.Size = 12
'Kommastellen formatieren
Range("b5:ac27").NumberFormat = "#,##0.00"
Range("b39:ac56").NumberFormat = "#,##0.00"
Range("b31:ac31").NumberFormat = "#,##0.00"
Range("b60:ac60").NumberFormat = "#,##0.00"
Range("b29:ac29").NumberFormat = "#,##0"
Range("b58:ac58").NumberFormat = "#,##0"
Range("A5:ac5").Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Range("A39:ac39").Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Range("A25:ac25").Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Range("A54:ac54").Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Range("b1:b31").Select
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Range("b35:b60").Select
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Range("A10:ac10").Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("A44:ac44").Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("A14:ac14").Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
'negative Werte in ROT
Sheets("übersicht").Activate
Set bereich = Range("c19:ac19")
For Each Zelle In bereich
If Zelle.Value < 0 Then
Zelle.Interior.ColorIndex = 3
Else: Zelle.Interior.ColorIndex = 1
End If
Next Zelle
Set bereich = Range("c31:ac31")
For Each Zelle In bereich
If Zelle.Value < 0 Then
Zelle.Interior.ColorIndex = 3
Else: Zelle.Interior.ColorIndex = 1
End If
Next Zelle
Set bereich = Range("c48:ac48")
For Each Zelle In bereich
If Zelle.Value < 0 Then
Zelle.Interior.ColorIndex = 3
Else: Zelle.Interior.ColorIndex = 1
End If
Next Zelle
Set bereich = Range("c60:ac60")
For Each Zelle In bereich
If Zelle.Value < 0 Then
Zelle.Interior.ColorIndex = 3
Else: Zelle.Interior.ColorIndex = 1
End If
Next Zelle
'Löschen der Leerspalten
Application.ScreenUpdating = False
For Leerspalten = 256 To 1 Step -1
If Application.CountA(Columns(Leerspalten)) = 0 Then
Columns(Leerspalten).Delete
End If
Next
'Sortieren absteigend nach VK-Menge
Range("C1:ac31").Select
Selection.Sort Key1:=Range("C29"), Order1:=xlDescending, Header:=xlGuess _
, OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, _
DataOption1:=xlSortNormal
Range("C35:ac60").Select
Selection.Sort Key1:=Range("C58"), Order1:=xlDescending, Header:=xlGuess _
, OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, _
DataOption1:=xlSortNormal
'Spaltenbreite festlegen
Cells.Select
With Selection
.WrapText = False
End With
Range("a1").Select
'Hier die maximale bzw. minimale Spaltenbreite einstellen
Const MaxBreite = 22
Const MinBreite = 14
mySpalte = Cells.SpecialCells(xlCellTypeLastCell).Column
Range(Cells(1, 1), Cells(1, mySpalte)).EntireColumn.AutoFit
For iSpalte = 1 To mySpalte
If Columns(iSpalte).ColumnWidth > MaxBreite Then _
Columns(iSpalte).ColumnWidth = MaxBreite
Next iSpalte
For iSpalte = 3 To mySpalte
If Columns(iSpalte).ColumnWidth < MinBreite Then _
Columns(iSpalte).ColumnWidth = MinBreite
Next iSpalte
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = "$A:$B"
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = "&P"
.RightFooter = TextBox20.Value & "   &D"
.LeftMargin = Application.InchesToPoints(0.393700787401575)
.RightMargin = Application.InchesToPoints(0.393700787401575)
.TopMargin = Application.InchesToPoints(0.393700787401575)
.BottomMargin = Application.InchesToPoints(0.393700787401575)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 3
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
End With
On Error Resume Next
Application.DisplayAlerts = False
Sheets("15999").Delete
Sheets("16999").Delete
ActiveWorkbook.Close SaveChanges:=True
MsgBox "Datei befindet im Verzeichnis:  F:\FIB\sonstiges\KTR"
Application.ScreenUpdating = True
End Sub

Anzeige
AW: Makro von einer anderen Userform ausführen
06.11.2006 14:36:19
einer
Hallo,
schreib ins Ereignis deiner Wahl im Userform1:
UserForm2.CommandButton38 = True
Den Namen des Userforms musst du natürlich anpassen.
Gruß K.Rola
klappt!
06.11.2006 14:58:19
Pascal
Besten Dank K.Rola für die schnelle Antwort, läuft einwandfrei!
Gruß Pascal

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige