|
Hallo zusammen
Ich habe ein userform bei welchem man den Abrechnungsmonat auswählen muss. Dieser wird dann einem anderen Makro weitergegeben und dort weiterverarbeitet.
Ich habe 4 Formulare. Bei 3 klappt das wie es soll, nur beim 4. kommt stets die Fehlermeldung "Mehrdeutiger Name".
Ich hab das Userform nochmal neu gebastelt; hat nichts gebracht. Hab es von einem funktionierenden kopiert; war auch ohne Erfolg.
Kann mir jemand weiterhelfen? Irgendetwas überseh' ich....
Hier der Code des Userforms:
Option Explicit
Private Sub UserForm_Initialize()
'Monats Drop Down box füllen - Januar bis Dezember
With Monat_int
.AddItem "Januar"
.AddItem "Februar"
.AddItem "März"
.AddItem "April"
.AddItem "Mai"
.AddItem "Juni"
.AddItem "Juli"
.AddItem "August"
.AddItem "September"
.AddItem "Oktober"
.AddItem "November"
.AddItem "Dezember"
End With
End Sub
Private Sub Ok_Click()
Monat = Monat_int.Value
Unload Me
End Sub
Und hier der Code des weiterverarbeitenden Makros:
Option Explicit
Dim Marke As String
Public Monat As String
Dim DokPfad As String
Dim DokPreis As String
Dim DokName As String
Dim Jahr As Integer
Dim Fileext As String
Dim xAlerts As Boolean
Dim WorkB As Workbook
Dim WBP As Workbook
Dim WSP As Worksheet
Dim WorkS As Worksheet
Dim xSht As Variant
Dim ThisPos As Range
Dim ThisRow As Long
Dim DokNameYear As String
Dim ZeileMax As Long
Dim Model As String
Dim PosMod As Range
Dim ModZeile As Long
Dim i As Variant
Dim Pfad As String
Sub Monats_Abrechnung_intern_Reinach()
Set WorkB = ThisWorkbook
Abrechnungs_Monat_intern.Show 'Monat wird in userform ausgewählt
If Monat = "Dezember" And Format(Date, "mmmm") = "Januar" Then 'basierend auf dem Abrechnungsmonat und dem aktuellen Monat wird das Jahr bestimmt
Jahr = Year(Date) - 1
Else
Jahr = Year(Date)
End If
Fileext = ".xlsx"
Pfad = "X:\6_Administration\Verkauf\Verkauf intern\"
DokName = ("Monatsabrechnung intern Reinach " & Monat & " " & Jahr & Fileext)
DokPfad = (Pfad & Monat & "\" & DokName)
DokPreis = (Pfad & "Preisliste.xlsm")
Set WBP = Workbooks.Open(DokPreis)
DokNameYear = (Pfad & "Jahresabrechnung intern Reinach " & Jahr & Fileext)
Workbooks.Add.SaveAs Filename:=DokPfad
'Liste der Sheet-Namen generieren
xAlerts = Application.DisplayAlerts
Application.DisplayAlerts = False
On Error Resume Next
On Error GoTo 0
For Each xSht In ThisWorkbook.Sheets
'Neue Workheets generieren & vorbereiten
Worksheets.Add(After:=Sheets(Sheets.Count)).Name = xSht.Name 'Worksheet in neuem Workbook namen der Worksheets des alten Workbooks zuweisen
WorkB.Worksheets("Finn Comfort").Range("A1:E1").Copy 'Inhalt der Titelzeile kopieren
ActiveSheet.Range("A1:E1").PasteSpecial (xlPasteFormats) 'Format der Titelzeile einfügen
ActiveSheet.Range("D1:G1").PasteSpecial (xlPasteFormats)
ActiveSheet.Range("A1:E1").PasteSpecial (xlPasteValues) 'Werte der Titelzeile einfügen
Application.CutCopyMode = False
ActiveSheet.Range("F1").Value = "EP"
ActiveSheet.Range("F2:F200").NumberFormat = "$ #,##0.00" 'Formatierung (CHF) der Spalte zuweisen
ActiveSheet.Range("G1").Value = "Summe"
ActiveSheet.Range("G2:G200").NumberFormat = "$ #,##0.00" 'Formatierung (CHF) der Spalte zuweisen
'----------Bedingte Formatierung einfügen
ActiveSheet.Range("A2:G200").FormatConditions.Add Type:=xlExpression, Formula1:="=UND((ISTLEER($F2)=WAHR);(ISTLEER($E2)=FALSCH))"
ActiveSheet.Range("A2:G200").FormatConditions(ActiveSheet.Range("A2:G200").FormatConditions.Count).SetFirstPriority
With ActiveSheet.Range("A2:G200").FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
ActiveSheet.Range("A2:G200").FormatConditions(1).StopIfTrue = False
'----------
'----------Nur jene Artikel aus dem gewählten Monat in neues File kopieren---------
Set ThisPos = WorkB.Worksheets(xSht.Name).Range("E:E").Find(What:=Monat, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False) 'ist bereits eine Ausgabe diese Models in der Liste?
If Not ThisPos Is Nothing Then 'falls eines in der Liste vorhanden ist:
Do
ThisRow = ThisPos.Row 'Zeilenzahl des Models
'MsgBox ("Die gefundene Zeile ist: " & ThisRow)
ActiveSheet.Range("A2").EntireRow.Insert CopyOrigin:=xlFormatFromRightOrBelow 'Neue Zeile einfügen oberhalb des Inhalts = direkt unterhalb der Titelzeile
ActiveSheet.Range("A2").Resize(1, 5).Value = WorkB.Worksheets(xSht.Name).Range("A" & ThisRow & ":E" & ThisRow).Value
WorkB.Worksheets(xSht.Name).Range("A" & ThisRow & ":E" & ThisRow).ClearContents 'Inhalt der Zeile löschen
Set ThisPos = WorkB.Worksheets(xSht.Name).Range("E:E").FindNext(ThisPos) 'Die Position des nächsten Models eruieren.
WorkB.Worksheets(xSht.Name).Range("A" & ThisRow & ":G" & ThisRow).Delete 'Komplete Zeile löschen und restlichen Inhalt nach oben verschieben
Loop While Not ThisPos Is Nothing
If xSht.Name = "Finn Comfort" Then
With WorkB.Worksheets(xSht.Name).Shapes("Schaltfläche 1")
.Top = .TopLeftCell.Offset(-1, 0).Top
End With
End If
Else
End If
'----------
'----------Preise in Monatsabrechnungsfile einfügen----------
Set WSP = WBP.Worksheets(xSht.Name)
ZeileMax = Workbooks(DokName).Worksheets(xSht.Name).Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To ZeileMax
Model = ActiveSheet.Range("C" & i).Value
Set PosMod = WSP.Range("A:A").Find(What:=Model, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not PosMod Is Nothing Then
ModZeile = PosMod.Row
ActiveSheet.Range("F" & i).Value = WSP.Range("D" & ModZeile).Value
ActiveSheet.Range("G" & i).Formula = "=$A" & i & "*$F" & i
Else
End If
Next
ActiveSheet.Range("F" & (ZeileMax + 2)).Value = "Summe:"
ActiveSheet.Range("G" & (ZeileMax + 2)).Formula = "=SUM($G$2:$G$" & ZeileMax & ")"
'----------
'----------NEU----------
Next
Application.DisplayAlerts = xAlerts
ActiveWorkbook.Save
If Monat = "Januar" Then
Workbooks.Add.SaveAs Filename:=DokNameYear
Else
Workbooks.Open(DokNameYear).Activate
End If
'--- Worksheet-Namen aus Verkaufslisten sheets in Jahresabschluss übernehmen
xAlerts = Application.DisplayAlerts
Application.DisplayAlerts = False
On Error Resume Next
On Error GoTo 0
For Each xSht In ThisWorkbook.Sheets
If Monat = "Januar" Then
Worksheets.Add(After:=Sheets(Sheets.Count)).Name = xSht.Name 'Worksheet in neuem Workbook namen der Worksheets des alten Workbooks zuweisen
WorkB.Worksheets("Finn Comfort").Range("A1:G1").Copy 'Inhalt der Titelzeile kopieren
ActiveSheet.Range("A1:G1").PasteSpecial (xlPasteFormats) 'Format der Titelzeile einfügen
ActiveSheet.Range("D1:G1").PasteSpecial (xlPasteFormats)
ActiveSheet.Range("A1:G1").PasteSpecial (xlPasteValues) 'Werte der Titelzeile einfügen
Application.CutCopyMode = False
ActiveSheet.Range("F1").Value = "EP"
ActiveSheet.Range("F2:F200").NumberFormat = "$ #,##0.00"
ActiveSheet.Range("G1").Value = "Summe"
ActiveSheet.Range("G2:G200").NumberFormat = "$ #,##0.00"
'----------Bedingte Formatierung in Jahresabschlus-File einfügen
ActiveSheet.Range("A2:G200").FormatConditions.Add Type:=xlExpression, Formula1:="=UND((ISTLEER($F2)=WAHR);(ISTLEER($E2)=FALSCH))"
ActiveSheet.Range("A2:G200").FormatConditions(ActiveSheet.Range("A2:G200").FormatConditions.Count).SetFirstPriority
With ActiveSheet.Range("A2:G200").FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
ActiveSheet.Range("A2:G200").FormatConditions(1).StopIfTrue = False
'----------
Else
End If
ZeileMax = Workbooks(DokName).Worksheets(xSht.Name).Cells(Rows.Count, 1).End(xlUp).Row
'MsgBox (ActiveWorkbook.Name)
Worksheets(xSht.Name).Activate 'Das gewünschte Worksheet aktivieren! ist sehr wichtig!
'MsgBox (ActiveSheet.Name)
If ZeileMax > 1 Then
'MsgBox (ZeileMax)
'Oben neue Zeilen einfügen
ActiveSheet.Range("A2").EntireRow.Resize(ZeileMax - 1, 7).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
' Inhalt einfügen
ActiveSheet.Range("A2").Resize(ZeileMax - 1, 7).Value = Workbooks(DokName).Worksheets(xSht.Name).Range("A2:G" & ZeileMax).Value
Else
End If
Next
Application.DisplayAlerts = xAlerts
ActiveWorkbook.Close SaveChanges:=True
Workbooks("Preisliste.xlsm").Close SaveChanges:=False
'With ThisWorkbook.ActiveSheet
'Marke = ActiveSheet.Name
'End With
End Sub
Was habe ich übersehen?
LG Domenic
|