Thema Datum  Von Nutzer Rating
Antwort
Rot Mehrdeutiger Name bei Input durch Userform
28.04.2021 17:43:37 Domenic Stamm
NotSolved
28.04.2021 18:59:52 Gast92407
NotSolved
28.04.2021 19:15:22 Gast7777
NotSolved
29.04.2021 07:24:42 Domenic Stamm
NotSolved
29.04.2021 08:08:47 Domenic Stamm
NotSolved
29.04.2021 13:26:57 Gast92407
Solved
29.04.2021 14:07:37 Domenic Stamm
NotSolved
29.04.2021 20:12:11 Gast67504
NotSolved

Ansicht des Beitrags:
Von:
Domenic Stamm
Datum:
28.04.2021 17:43:37
Views:
72
Rating: Antwort:
  Ja
Thema:
Mehrdeutiger Name bei Input durch Userform

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


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:

 
 

  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Mehrdeutiger Name bei Input durch Userform
28.04.2021 17:43:37 Domenic Stamm
NotSolved
28.04.2021 18:59:52 Gast92407
NotSolved
28.04.2021 19:15:22 Gast7777
NotSolved
29.04.2021 07:24:42 Domenic Stamm
NotSolved
29.04.2021 08:08:47 Domenic Stamm
NotSolved
29.04.2021 13:26:57 Gast92407
Solved
29.04.2021 14:07:37 Domenic Stamm
NotSolved
29.04.2021 20:12:11 Gast67504
NotSolved