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

falcon30 · 17.08.2006

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

Billy · 17.08.2006

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

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

falcon30 · 17.08.2006

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

Billy · 17.08.2006

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

falcon30 · 18.08.2006

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

Billy · 18.08.2006

falcon30 schrieb:
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

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

Matjes · 19.08.2006

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
     ->&lt;&lt;&lt; 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

Matjes · 19.08.2006

Du hast mail auf gmx

falcon30 · 21.08.2006

Hallo Matjes,

vielen Dank!!

Funktioniert 1A.

Grüße
falcon30

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

falcon30

Billy

falcon30

Billy

falcon30

Billy

Matjes

Matjes

falcon30

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

ANGEBOTE & SPONSOREN

Neueste Themen

Statistik des Forums