Excel Makro unterstützung

Dieses Thema Excel Makro unterstützung im Forum "Microsoft Office Suite" wurde erstellt von a234781, 19. Feb. 2005.

Thema: Excel Makro unterstützung Hallo zusammen Da ich von VBA keine grosse Ahnung habe bitte ich um die Hilfe von euch Speziallisten zum lösen des...

  1. Hallo zusammen

    Da ich von VBA keine grosse Ahnung habe bitte ich um die Hilfe von euch Speziallisten zum lösen des nachfolgenden ?Problems?.

    In einer Excel Arbeitsmappe (Version 2003) mit 16 Blättern darf ein User (A) alles bearbeiten alle andern User dürfen nur Einträge in freigegebene Zellen machen. Alle Arbeitsblätter sind mit einem Blattschutz versehen.

    Ausgangssituation:
    Bei User A habe ich in ?\XLSTART\Personl.xls? die Makros ?AlleBlaetter_Schuetzen? und ?AlleBlaetter_Oeffnen? abgelegt welche er über Alt+F8 ausführen kann.

    Wunschsituation:
    Für User A, abhängig vom Anmeldenamen, steht ein ToggleButton oder etwas ähnliches zur Verfügung mit welchem er die zwei Makros starten kann ohne dass die Makros beim User A im ?Personl.xls? installiert werden müssen.

    Makro AlleBlaetter_Schuetzen:
    Sub AlleBlaetter_Schuetzen()
    Dim s
    Dim Name As Variant
    Name = ActiveSheet.Name
    Application.ScreenUpdating = False
    For s = 1 To Sheets.Count
    Sheets(s).Select
    ActiveSheet.Protect Password:=Test, DrawingObjects:=True, Contents:=True, Scenarios:=True
    ActiveSheet.EnableSelection = xlUnlockedCells
    Next s
    Sheets(Name).Select
    Application.ScreenUpdating = True
    End Sub

    Makro AlleBlaetter_Oeffnen
    Sub AlleBlaetter_Oeffnen()
    Dim s
    Dim Name As Variant
    Name = ActiveSheet.Name
    Application.ScreenUpdating = False
    For s = 1 To Sheets.Count
    Sheets(s).Select
    ActiveSheet.Unprotect Password:=Test
    Next s
    Sheets(Name).Select
    Application.ScreenUpdating = True
    End Sub

    Besten Dank zum Voraus

    Gruss zoggeli
     
  2. Hallo zoggeli,

    man könnte das komplett ohne Toggel-Button folgendermassen lösen:

    In die Code-Seite von->DieseArbeitsmappe' folgenden Code per Copy und Paste eingeben.
    Code:
    Private Sub Workbook_BeforeClose(Cancel As Boolean)
      Call AlleBlaetter_Schuetzen
      ActiveWorkbook.Save
    End Sub
    
    Private Sub Workbook_Open()
      Const c_userA = UserA
      Dim s_name As String
      If c_userA = Application.UserName Then
        Call AlleBlaetter_Oeffnen
      End If
    End Sub
    Private Function AlleBlaetter_Schuetzen()
      Dim s As Long, Name As String
      Application.ScreenUpdating = False
      Name = ActiveSheet.Name
      For s = 1 To Sheets.Count
        Sheets(s).Protect Password:=Test, DrawingObjects:=True, Contents:=True, Scenarios:=True
        Sheets(s).EnableSelection = xlUnlockedCells
      Next s
      Sheets(Name).Select
      Application.ScreenUpdating = True
    End Function
    Private Function AlleBlaetter_Oeffnen()
      Dim s As Long, Name As String
      Name = ActiveSheet.Name
      Application.ScreenUpdating = False
      For s = 1 To Sheets.Count
        Sheets(s).Unprotect Password:=Test
      Next s
      Sheets(Name).Select
      Application.ScreenUpdating = True
    End Function
    Workbook_Open:
    Wird beim Öffnen der Mappe ausgerufen.
    Ist der User UserA, wird AlleBlaetter_Oeffnen ausgeführt.
    Hier mußt Du der Konstanten c_userA noch den richtigen Usernamen zuordnen.

    Workbook_BeforeClose:
    Wenn die Arbeismappe geschlossen wird,
    wird vorher Workbook_BeforeClose ausgeführt.
    Der Schutz wird gesetzt, und die Änderungen gespeichert.

    Deine Subs hab ich in Private Functions geändert, so dass sie ohne Makro nicht mehr aufrufbar sind.

    Wenn Du verhindern willst, daß jemand über die Makros an den Usernamen kommt, kannst Du das in den Projekt-Eigenschaften->Schutz mit einem Passwort erreichen, ohne das sich dann die Makros nicht mehr ansehen lassen.

    Gruß Matjes :)
     
  3. Hallo Matjes

    Du bist einfach genial ;) es funktioniert einwandfrei, Besten Dank.
    Einen kleinen Schönheitsfehler hat es noch, die User ohne Berechtigung können auch die gesperrten Zellen anwählen. Kann man das verhindern, wenn ja wie?

    Besten Dank für Deine Hilfe

    Gruss zoggeli
     
  4. Hallo zoggeli,

    das könnte mit folgendem Makro bewerkstelligt werden.
    Code:
    Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
      
      Const c_UserA = UserA
      
      Dim zelle As Range, b_lockedcell As Boolean
      
     ->Für alll außer UserA
      If Application.UserName <> c_UserA Then
        b_lockedcell = False
        For Each zelle In Target
          If zelle.Locked Then
            MsgBox (gesperrte Zellen können nicht selektiert werden)
            b_lockedcell = True
            Exit For
          End If
        Next
        If b_lockedcell Then
         ->erste nicht gesperrte Zelle selektieren
          For Each zelle In UsedRange
            If Not zelle.Locked Then
              Application.EnableEvents = False
              zelle.Select
              Application.EnableEvents = True
              Exit For
            End If
          Next
        End If
        Set zelle = Nothing
      End If
    End Sub
    Das Makro muß in der Code-Seite jeder Tabelle stehen.
    (im Projektfenster ´z.B. Tabelle1(Blattname))

    Const c_UserA = UserA
    muß mit dem entsprechenden Benutzernamen angepaßt werden.

    Die MsgBox kann entfernt werden.

    Gruß Matjes  ;)
     
  5. Hallo Matjes

    Was soll ich sagen....auch dieses Script funktioniert tadellos.

    Nochmals herzlichen Dank für Deine Hilfe.

    Gruss zoggeli
     
Die Seite wird geladen...

Excel Makro unterstützung - Ähnliche Themen

Forum Datum
Excel VBA Makro zum suchen eines Textes und anschließend einen Breich zu kopieren Microsoft Office Suite 22. Jan. 2015
Excel VBA Makro zum suchen und markieren von Zeilen die ein bestimmtes Wort enthalten Microsoft Office Suite 16. Juni 2014
Excel: Makro ASCII verschieben Windows XP Forum 8. Nov. 2013
Makros und anderes - Excel Microsoft Office Suite 15. März 2013
Excel Sprungmarke mitten in ein anderes Makro Windows XP Forum 15. März 2012