Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

zwei macros in einem Tabellenblatt

zwei macros in einem Tabellenblatt
30.01.2016 14:57:52
Peter
Hallo Leute,ich verzweifle an folgendem Problem.
Ich habe zwei Macros in einem Tabellenblatt.Einzeln laufen die, wenn ich aber beide drin habe geht es nicht, Sieht jemand den Fehler?
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim z1
Dim eingbereich
If Sheets("Fahrer").Range("n1").Value = "an" Then
z1 = Selection.Row
Set eingbereich = Range("c9:k1600")
eingbereich.Interior.ColorIndex = xlNone
If Application.Intersect(Selection, eingbereich) Is Nothing Then Exit Sub
Range(Cells(z1, 1), Cells(z1, 11)).Interior.ColorIndex = 36 'gelb 36
End If
If Sheets("Fahrer").Range("n1").Value = "aus" Then
z1 = Selection.Row
Set eingbereich = Range("c9:k1600")
eingbereich.Interior.ColorIndex = xlNone
If Application.Intersect(Selection, eingbereich) Is Nothing Then Exit Sub
End If
'#Exit Sub
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim schlNr
Dim Bezeich
Dim Ort
ActiveSheet.Unprotect ("")
Dim strDir As String
Cancel = True
If Target.Column  3 Then Exit Sub
If IsEmpty(Target) Then Exit Sub
schlNr = ActiveCell(3, 3)
Bezeich = ActiveCell(3, 4)
Ort = ActiveCell(3, 5)
'With ActiveWorkbook.Worksheets("drucken")
'With Sheets("drucken")
With drucken
Worksheets("drucken").Range("a13").Value = schlNr
Worksheets("drucken").Range("b13").Value = Bezeich
Worksheets("drucken").Range("c13").Value = Ort
End With
'End If
ActiveSheet.Protect ("")
Sheets("drucken").Select
'End With
End Sub

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: zwei macros in einem Tabellenblatt
30.01.2016 21:20:40
Peter
Hallo Peter,
wahrscheinlich löst dein Makro Worksheet_BeforeDoubleClick das Change Ereignis aus und das könnte den Kummer auslösen.
Du solltest also das Change-Ereignis nicht stattfinden lassen, indem du im Worksheet_BeforeDoubleClick
zu Beginn ein Application.EnableEvents = False und am Ende ein Application.EnabelEvents = True einfügst.
Gruß Peter

AW: zwei macros in einem Tabellenblatt
30.01.2016 22:21:44
Gerd
Hallo Peter,
probier mal.
Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim eingbereich As Range
Me.Unprotect ("")
Set eingbereich = Range("c9:k1600")
If Application.Intersect(Selection, eingbereich) Is Nothing Then Exit Sub
If Sheets("Fahrer").Range("n1").Value = "an" Then
eingbereich.Interior.ColorIndex = xlNone
Range(Cells(Selection.Row, 1), Cells(Selection.Row, 11)).Interior.ColorIndex = 36 'gelb 36
ElseIf Sheets("Fahrer").Range("n1").Value = "aus" Then
eingbereich.Interior.ColorIndex = xlNone
End If
Me.Protect ("")
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Me.Unprotect ("")
'#'Cancel = True
If Target.Column  3 Or IsEmpty(Target) Then Exit Sub
With Worksheets("drucken")
.Range("A13:C13").Value = Target.Offset(2, 2).Resize(1, 3).Value
.Activate
End With
Me.Protect ("")
End Sub
Gruß Gerd

Anzeige
AW: zwei macros in einem Tabellenblatt
31.01.2016 12:14:48
Peter
Hallo Gerd,
die Fehlermeldung ist weg. dafür schreibt er aber die Daten nicht in das andere Tabelenblatt.
Gruß Peter

AW: zwei macros in einem Tabellenblatt
31.01.2016 12:33:05
Gerd
Hallo Peter!
Aus deinem Doubleclick-Code:
schlNr = ActiveCell(3, 3)
Bezeich = ActiveCell(3, 4)
Ort = ActiveCell(3, 5)
Welche Zellen, bezogen auf die aktive Zelle sollten dies tatsächlich sein?
Ich habe mit
Target.Offset(2, 2).Resize(1, 3).Value
da etwas geraten.
Gruß Gerd

AW: zwei macros in einem Tabellenblatt
01.02.2016 18:33:07
Peter
Zuerst einmal möchte ich mich für eure Hilfe Bedanken.
Ich schaffe es zeitlich leider nicht immer gleich zu Antworten.
Ich habe jetzt die Lösung aus einem Mix eurer Voerschläge gefunden. Es funkioniert.
Ich stelle den Code mal mit rein.
vielen Dank und Gruß
Peter
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim eingbereich As Range
Me.Unprotect ("")
Set eingbereich = Range("c9:k1600")
If Application.Intersect(Selection, eingbereich) Is Nothing Then Exit Sub
If Sheets("Fahrer").Range("n1").Value = "an" Then
eingbereich.Interior.ColorIndex = xlNone
Range(Cells(Selection.Row, 1), Cells(Selection.Row, 11)).Interior.ColorIndex = 36 'gelb 36
ElseIf Sheets("Fahrer").Range("n1").Value = "aus" Then
eingbereich.Interior.ColorIndex = xlNone
End If
Me.Protect ("")
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim schlNr
Dim Artickel
Dim Ort
Dim stück
Dim maße
ActiveSheet.Unprotect ("")
Dim strDir As String
Cancel = True
If Target.Column  3 Then Exit Sub
If IsEmpty(Target) Then Exit Sub
schlNr = ActiveCell(1, 1)
stück = ActiveCell(1, 2)
Artickel = ActiveCell(1, 3)
maße = ActiveCell(1, 4)
'With ActiveWorkbook.Worksheets("drucken")
With Sheets("drucken")

Anzeige
warum neuer Threat?
31.01.2016 18:02:27
KlausF
Hallo Peter,
warum bleibst du nicht im alten Threat und gibst erst einmal ein
Feedback zu der angebotenen Lösung und der darin enthaltenen Vermutung?
https://www.herber.de/forum/messages/1472132.html
Gruß
Klaus

304 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige