Brauche Hilfe beim Excel VBA Code

Pr3d4tor · 7. Februar 2021

Guten Morgen zusammen,

zu erst einmal muss ich gestehen das ich kaum Erfahrung mit VBA habe und mich immer nur dann damit beschäftige
wenn mir ein neues Projekt in den Sinn kommt (also Learning by doing

).
So Ehrlich sollte ich dann doch schon sein.

Im Moment „Bastle“ ich an einer „Übersichttabelle“ von der aus ich die täglichen Aufgaben
per Button erledigen kann. Darunter fällt auch das Drucken verschiedene Dokumente, mal zwingend/sicherheitshalber mit Druckvorschau,
oder auch nur mit Angabe der Anzahl an Kopien.

Mittlerweile habe ich das Ganze auch, zumindest für mich, sehr zufriedenstellend hinbekommen.
Da ich die Übersichtstabelle aber nicht nur von einem PC aus nutze und sie außerdem meinem Arbeitskollegen zur Verfügung stellen möchte kämpfe ich gerade mit dem Pfad inkl. Dem Windowsbenutzer. Mal abgesehen davon das wohl noch einiges dazu kommt so daß die Pfad Angabe so am sinnvollsten ist und ich den Pfad nicht jedes mal anpassen muss.

Bisher sieht der Code in einem Modul so aus:

Visual Basic:

Option Explicit

Dim blnResponse As Boolean
      Const SDRUCKPATH = "C:\Users\Benutzername\Documents\druckdaten\"     
            Const SWASAUCHIMMER = "Muster Leitzettel.xlsx"

Sub Leit_Druck_01_Click()
      Application.ScreenUpdating = False
      Application.EnableEvents = False
On Error GoTo ERRORHANDLER
      Workbooks.Open (SDRUCKPATH & SWASAUCHIMMER)
            ActiveWorkbook.Sheets("Leitzettel nmf").Activate
      blnResponse = Application.Dialogs(xlDialogPrinterSetup).Show
         If blnResponse = True Then
             ActiveSheet.PrintPreview
    End If
      ActiveWorkbook.Close savechanges:=False
      
ERRORHANDLER:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Sub Leit_Druck_02_Click()
      Application.ScreenUpdating = False
      Application.EnableEvents = False
On Error GoTo ERRORHANDLER
      Workbooks.Open (SDRUCKPATH & SWASAUCHIMMER)
            ActiveWorkbook.Sheets("Lux_mit_Pan").Activate
      blnResponse = Application.Dialogs(xlDialogPrinterSetup).Show
         If blnResponse = True Then
             ActiveSheet.PrintPreview
    End If
    ActiveWorkbook.Close savechanges:=False

ERRORHANDLER:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

'# usw.
'# mittlerweile geht das ganze schon bis Druck_20_ oder so

Auf der Suche nach einer Lösung und in der Hoffnung dass ich das dann Umgesetzt bekomme habe ich diesen Code gefunden.

Visual Basic:

Private Declare PtrSafe Function GetUserName Lib "advapi32.dll" _
Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Public Sub whoisUser()
     Dim strUserName As String
      strUserName = String$(100, vbNullChar)
      Call GetUserName(strUserName, 100)
      strUserName = Left$(strUserName, InStr(strUserName, vbNullChar) - 1)
End Sub

Nun die eigentliche Frage an die Profis hier:
Wie kann/muss ich diesen Code in meinem Unterbringen damit es funktionier?
Denn soweit wie ich weiß bzw. rausfinden konnte klappt das ja schon mal nicht mit nem konstanten Pfad.

Hab jetzt schon einige Versuche hinter mir aber hinbekommen habe ich es leider noch nicht :-(
Daher hoffe ich nun hier jemanden zu finden der Erbarmen hat und mir den Code entsprechend ändert.

VG
und allen nen schönen Sonntag

Zvoni · 8. Februar 2021

Wieso so umständlich?
Hier ein Beispiel um zum Desktop des eingeloggten Users zu kommen......

Code:

sPath = Environ("USERPROFILE") & "\Desktop"
Debug.Print "c:\Users\" & sPath

Wenn du es mal ganz durch die Hintertür machen willst kannst du auch den Registry-Key
Computer\HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders
auslesen (Dort den Schlüssel "Personal" für Documents).
Auf diese Art bekommst du auch den Ordner, falls der woanderst liegen sollte (Netzwerk-Ordner zum Beispiel)

Pr3d4tor · 8. Februar 2021

Naja ob das Umständlich ist kann ich leider nicht sagen, daher glaube ich dir das einfach mal.
Allerdings habe ich mich gestern auch durch soviele Threads gelesen das ich gar nicht mehr genau weiß warum am Ende das übergeblieben ist. Ich meine aber irgendwo gelesen zu haben dass das mit "USERPROFILE" wohl nicht geht.

Naja wie dem auch sei, werde ich mich wohl die Tage sobald ich die Ruhe dazu finde nochmal weiter einlesen müssen.

Spontan getestet habe ich folgendes:

Visual Basic:

Option Explicit

Dim blnResponse As Boolean
'# Const SDRUCKPATH = "C:\Users\adwfwm\Documents\druckdaten\"
'#      Const SWASAUCHIMMER = "Muster Leitzettel.xlsx"
Dim strDateiname As String
Dim strPfad As String
    
    strPfad = Environ$("USERPROFILE") & "\Documents\druckdaten\"
    strDateiname = "Muster Leitzettel"
  
Sub Leit_Druck_01_Click()
      Application.ScreenUpdating = False
      Application.EnableEvents = False
      
On Error GoTo ERRORHANDLER
'#      Workbooks.Open (DefaultPath & SWASAUCHIMMER)
        Workbooks.Open Filename:=strPfad & strDateiname & ".xlsx"
            ActiveWorkbook.Sheets("Leitzettel Medion").Activate
      blnResponse = Application.Dialogs(xlDialogPrinterSetup).Show
         If blnResponse = True Then
             ActiveSheet.PrintPreview
    End If
      ActiveWorkbook.Close savechanges:=False
      
ERRORHANDLER:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Da bekomme ich aber die Meldung "Außerhalb einer Prozedur ungültig"
ebenso bei:

Visual Basic:

Dim blnResponse As Boolean
Dim strPfad As String
    strPfad = Environ$("USERPROFILE") & "\Documents\druckdaten\"
'# Const SDRUCKPATH = "C:\Users\adwfwm\Documents\druckdaten\"
'#      Const SWASAUCHIMMER = "Muster Leitzettel.xlsx"
    

Sub Leit_Druck_01_Click()
      Application.ScreenUpdating = False
      Application.EnableEvents = False
      
On Error GoTo ERRORHANDLER
'#      Workbooks.Open (DefaultPath & SWASAUCHIMMER)
        Workbooks.Open Filename:=strPfad & "\Muster Leitzettel.xlsx"
            ActiveWorkbook.Sheets("Leitzettel Medion").Activate
      blnResponse = Application.Dialogs(xlDialogPrinterSetup).Show
         If blnResponse = True Then
             ActiveSheet.PrintPreview
    End If
      ActiveWorkbook.Close savechanges:=False
      
ERRORHANDLER:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Da werde ich wohl noch ein wenig mehr "learning by doing" betreiben müssen

Zvoni · 9. Februar 2021

Du hast nicht genau hingeschaut....
Mach mal ein frische Excel-Mappe auf, und wechsel in then Code-Editor

Code:

Sub Irgendwas()
Dim strPfad As String
   strPfad = Environ$("USERPROFILE") & "\Documents\druckdaten\"
   MsgBox strPfad
End Sub

Eine Zuweisung an eine Variable kann nur innerhalb einer Prozedur stattfinden!

EDIT: Habs gerade gesehen: Du hast nen Backslash zuviel.

Code:

Workbooks.Open Filename:=strPfad & "\Muster Leitzettel.xlsx"

Nimm den letzten Backslash bei strPfad raus

Code:

strPfad = Environ$("USERPROFILE") & "\Documents\druckdaten"

Pr3d4tor · 9. Februar 2021

Guten Morgen,

hab mich jetzt nochmal ein wenig damit Beschäftigt und das ganze wie folgt umgeändert:
(was im Übrigen auch soweit funzt)

Visual Basic:

Sub Leit_Druck_01_Click()
    Dim strDateiname As String
        strDateiname = "\Muster Leitzettel"

    Dim strPfad As String
        strPfad = Environ$("USERPROFILE") & "\Documents\druckdaten"

      Application.ScreenUpdating = False
      Application.EnableEvents = False
      
On Error GoTo ERRORHANDLER
        Workbooks.Open Filename:=strPfad & strDateiname & ".xlsx"
            ActiveWorkbook.Sheets("Leitzettel Medion").Activate
      blnResponse = Application.Dialogs(xlDialogPrinterSetup).Show
         If blnResponse = True Then
             ActiveSheet.PrintPreview
    End If
      ActiveWorkbook.Close savechanges:=False
      
ERRORHANDLER:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Wobei ich jetzt aber definitv Eure Hilfe brauche (im Idealfall sogar direkt den passenden Code) ist
die Möglichkeit den ganze Code "zu kürzen"
Es soll ja immer die gleiche Arbeitsmappe im gleichen Pfad geöffnet werden und anschließend durch Auswahl des Buttons, anhand des Arbeitsblattnames, das richtige Tabellenblatt geöffnet werden.

Ursprünglich sieht das ja so aus:

Visual Basic:

Workbooks.Open (SDRUCKPATH & SWASAUCHIMMER)
            ActiveWorkbook.Sheets("Leitzettel nmf").Activate

Daher habe ich es in dem neuen Code direkt mal mit "Sub nSheet(sName As String)" versucht
um dann die einzelnen Blätter über:

Visual Basic:

Sub nSheet(sName As String)
.
.
            ActiveWorkbook.Sheets("sName").Activate
.
Sub Leit_Druck_01_Click()
    nSheet "Leitzettel Medion"
End Sub

Sub Leit_Druck_02_Click()
    nSheet "Lux_mit_Pan"
End Sub

'usw.

aufzurufen.

Die Umstellung des Codes funktioniert zwar und die Datei wird auch geöffnet nur eben nicht das richtige Blatt. Allerdings bin ich mit meinem Latein noch lange nicht soweit um das ganze zu kürzen :-(
Daher nun die Frage wie kann ich das ganze "kürzen" oder "zusammenfassen"

Also alter Code:

Visual Basic:

Option Explicit

Dim blnResponse As Boolean
      Const SDRUCKPATH = "C:\Users\Benutzername\Documents\druckdaten\"     
            Const SWASAUCHIMMER = "Muster Leitzettel.xlsx"

Sub Leit_Druck_01_Click()
      Application.ScreenUpdating = False
      Application.EnableEvents = False
On Error GoTo ERRORHANDLER
      Workbooks.Open (SDRUCKPATH & SWASAUCHIMMER)
            ActiveWorkbook.Sheets("Leitzettel nmf").Activate
      blnResponse = Application.Dialogs(xlDialogPrinterSetup).Show
         If blnResponse = True Then
             ActiveSheet.PrintPreview
    End If
      ActiveWorkbook.Close savechanges:=False
      
ERRORHANDLER:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Sub Leit_Druck_02_Click()
      Application.ScreenUpdating = False

' usw.

Neuer Code:

Visual Basic:

Sub nSheet(sName As String)
    Dim strDateiname As String
        strDateiname = "\Muster Leitzettel"

    Dim strPfad As String
        strPfad = Environ$("USERPROFILE") & "\Documents\druckdaten"

      Application.ScreenUpdating = False
      Application.EnableEvents = False
      
On Error GoTo ERRORHANDLER
        Workbooks.Open Filename:=strPfad & strDateiname & ".xlsx"
            ActiveWorkbook.Sheets("sName").Activate
      blnResponse = Application.Dialogs(xlDialogPrinterSetup).Show
         If blnResponse = True Then
             ActiveSheet.PrintPreview
    End If
      ActiveWorkbook.Close savechanges:=False
      
ERRORHANDLER:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Und vorab nochmal ein riesen Danke schön an alle die weiter Helfen können.

VG

Zvoni · 9. Februar 2021

Code:

ActiveWorkbook.Sheets("sName").Activate
'ändern in
ActiveWorkbook.Sheets(sName).Activate

In deinem Code suchst du nach einem Tabellenbaltt namens "sName"

Pr3d4tor · 9. Februar 2021

Also Sachen gibts....
Das ist wieder so ein "vor lauter Bäumen" und so.

Damit dürfte der Teil des Projektes hoffentlich abgeschlossen sein.
Ich meld mich dann wieder wenn der spannende Teil los geht

Als nächstes soll über ein Button die aktuelleste CSV Datei gefunden und "im Hintergrund bzw. Unsichtbar" geöffnet werden. Ganze Zeilen (von/bis) sollen gelöscht werden und bei einer Spalte muss das Format angepasst werden, abschließend soll das ganze natürlich wieder als CSV gespeichert werden.
Und damit es nicht langweilig wird soll im Dateinamen ans Ende das aktuelle Datum inkl. Uhrzeit.

Wenn du also spontan passende Forenlinks oder so zur Hand hast, ich nehm die gerne ;-)

Nochmals Danke schön an Euch für die Hilfe.
Ich werde die Tage nochmal darauf zurück kommen.

Brauche Hilfe beim Excel VBA Code

Pr3d4tor

Mitglied

Zvoni

Erfahrenes Mitglied

Pr3d4tor

Mitglied

Zvoni

Erfahrenes Mitglied

Pr3d4tor

Mitglied

Zvoni

Erfahrenes Mitglied

Pr3d4tor

Mitglied

Neue Beiträge