Excel: Makros gültig für nahezu alle WS

Dieses Thema Excel: Makros gültig für nahezu alle WS im Forum "Microsoft Office Suite" wurde erstellt von falcon30, 17. Aug. 2006.

Thema: Excel: Makros gültig für nahezu alle WS Hallo Zusammen, ich habe ein Makro was eigentlilch für nahezu alle WS gültig ist. Ich möchte mein Makro nicht in...

  1. Hallo Zusammen,

    ich habe ein Makro was eigentlilch für nahezu alle WS gültig ist.

    Ich möchte mein Makro nicht in jedes WS kopieren, denn der Änderungsaufwand wäre dann enorm.

    Gibt es eine Möglichkeit die Makros in ein Modul zu packen und den Aufruf dann in den WS durchzuführen?

    Vielen Dank im Voraus.

    Grüße
    falcon30
     
  2. Jop gibt es

    und zwar in dem du dein Makrocode in Diese Arbeitsmappe kopierst. Darauf klickst du auf Workbook und darauf links auf SheetChange. Dein Code darauf in:

    Code:
    Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    
    End Sub
    Worksheet ist Sh und falls du die geänderte Zellen brauchst ist dies Target

    alles klar? ;)

    MfG Billy
     
  3. Hallo Billy,

    vielen dank für deine Hilfe, doch leider kapiere ich es noch nicht ganz.

    Also ich habe mein Code in DieseArbeitsmappe kopiert.

    und nun?

    Hier ist mein Code:

    Code:
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      
      Dim d As Range
      Set d = Range(D8:D100)
      Dim e As Range
      Set e = Range(E8:E100)
    
       
      Set Targetd = Intersect(d, Target)
    
      If Not Targetd Is Nothing Then
        ActiveSheet.Unprotect 
        For Each d In Targetd.Cells
          With d
          
            If .Value =  Then
              .Value = x
              Cells(.Row, E).ClearContents
              
           ->Else
            ->  .Value = 
            ->
            ->  Cells(.Row, H).Locked = False
            ->  Cells(.Row, H).Value = x
              
            End If
          End With
        Next
                
         ActiveSheet.Protect 
      End If
    
     Set Targete = Intersect(e, Target)
      If Not Targete Is Nothing Then
         ActiveSheet.Unprotect 
        For Each e In Targete.Cells
          With e
          
            If .Value =  Then
              .Value = x
              Cells(.Row, D).ClearContents
              
           ->Else
            ->  .Value = 
            ->
            ->  Cells(.Row, H).Locked = False
            ->  Cells(.Row, H).Value = x
              
            End If
          
         If Cells(.Row, E).Value = x Then
          
          
         ->Maßnahmen.Show
          
           frmEdit.Show->###16.08.2006
          
          End If
          
          
          End With
          
          
        
        Next
         
        
        ActiveSheet.Protect 
      
      End If
    
    
    
    
    
    End Sub
    
    
    Was muss ich nun machen? Was mach ich mit den betroffenen WS, müssen da nicht auch ein paar Zeilen Code hinzugefügt werden?


    Grüße
    falcon 30
     
  4. Hi

    das müsstest du dann in folgendes um ändern

    Code:
    Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    
    Dim d As Range, e As Range, Targetd
    Set d = ActiveSheet.Range(D8:D100)
    Set e = ActiveSheet.Range(E8:E100)
    Set Targetd = Intersect(d, Target)
    
    If Not Targetd Is Nothing Then
     ActiveSheet.Unprotect 
     
     For Each d In Targetd.Cells
      With d
       If .Value =  Then
        .Value = x
        Cells(.Row, E).ClearContents
     
      ->Else
      ->  .Value = 
      ->
      ->  Cells(.Row, H).Locked = False
      ->  Cells(.Row, H).Value = x
       End If
      End With
     Next
      
     ActiveSheet.Protect 
    End If
    
    Set Targete = Intersect(e, Target)
    
    If Not Targete Is Nothing Then
     ActiveSheet.Unprotect 
     
     For Each e In Targete.Cells
      With e
       If .Value =  Then
        .Value = x
        Cells(.Row, D).ClearContents
      ->Else
      ->  .Value = 
      ->
      ->  Cells(.Row, H).Locked = False
      ->  Cells(.Row, H).Value = x
       End If
    
       If Cells(.Row, E).Value = x Then
       ->Maßnahmen.Show
        frmEdit.Show->###16.08.2006
       End If
      End With
     Next
     
     ActiveSheet.Protect 
    End If
    
    End Sub
    
    da ich leider nicht über deinen Dialog verfüge konnte ich es nicht vollständig testen
     
  5. Hallo Billy,

    leider funktioniert es nicht, oder ich habe mal wieder was nicht verstanden.

    Ich habe ca. 20 WS und das Makro darf nur in ca 15 WS funktionieren.

    Du kannst das ganze Testen, wenn Du folgende Zeile entfernst:

    Code:
     frmEdit.Show->###16.08.2006 
    Vielen Dank für die Hilfe!!

    Grüße
    falcon30
     
  6. du musst es nur so einfügen wie ich es dir gesagt hat... logischer weise musst du dann die original sachen löschen... klar?

    sonst schick mir mal die Datei per E-Mail
     
  7. Hallo falcon30,

    so funktioniert Billys Version für ausgesuchte Blaetter.

    Gruß Matjes :)
    Code:
    Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)
      
     Dim myTarget As Range, Zelle As Range
     
    ->Blattnamen, auf denen der Makro durchgeführt werden soll
     Dim Blaetter As Variant, bBlattBearbeiten As Boolean, x As Long
     Blaetter = Array( _
           Tabelle1, Tabelle2, _
           Tabelle4, Tabelle5, Tabelle6)
     bBlattBearbeiten = False
     For x = LBound(Blaetter) To UBound(Blaetter)
      If Blaetter(x) = Sh.Name Then
       bBlattBearbeiten = True
       Exit For
      End If
     Next
     
     If bBlattBearbeiten Then
     
     ->Bereich D8:D100
      Set myTarget = Intersect(Sh.Range(D8:D100), Target)
      If Not myTarget Is Nothing Then
       Sh.Unprotect 
       For Each Zelle In myTarget.Cells
        With Zelle
         If .Value =  Then
          .Value = x
          Sh.Cells(.Row, E).ClearContents
         End If
        End With
       Next
       Sh.Protect 
      End If
     
     ->Bereich E8:E100
      Set myTarget = Intersect(Sh.Range(E8:E100), Target)
      If Not myTarget Is Nothing Then
       Sh.Unprotect 
       For Each Zelle In myTarget.Cells
        With Zelle
         If .Value =  Then
          .Value = x
          Sh.Cells(.Row, D).ClearContents
         End If
         If Cells(.Row, E).Value = x Then
         -><<< für Test Msgbox >>>
         ->Maßnahmen.Show
         ->frmEdit.Show->###16.08.2006
          MsgBox Zu Testzwecken Msgbox als Maßnahmen-Dialog-Ersatz
         End If
        End With
       Next
       Sh.Protect 
      End If
     ->Aufraeumen
      Set myTarget = Nothing: Set Zelle = Nothing
     End If
     
    End Sub
     
  8. Du hast mail auf gmx  ;)
     
  9. Hallo Matjes,

    vielen Dank!!

    Funktioniert 1A.

    Grüße
    falcon30
     
Die Seite wird geladen...

Excel: Makros gültig für nahezu alle WS - Ähnliche Themen

Forum Datum
Makros und anderes - Excel Microsoft Office Suite 15. März 2013
Documents2Go Excel Makros Windows XP Forum 29. Apr. 2008
excel-makros in staroffice und openoffice StarOffice, OpenOffice und LibreOffice 6. März 2008
Excel 2007 Formeln Makros etc. immer richtige Verknüpfung Windows XP Forum 13. Juli 2007
Excel 2000 Globale Makros Windows XP Forum 7. Aug. 2006