Office: (Office 2010) Laufzeitfehler 400

Chillor · 2. Februar 2016

das folgende Problem taucht seltsamerweise nicht immer auf, aber oft, wieso kann ich mir aber nicht erklären.

ist die Datei schreibgeschützt geöffnet und wird innerhalb der Tabelle nichts gemacht läuft im Hintergrund ein Countdown zum schließen der Tabelle. ist der erste Countdown abgelaufen (5min), geht eine Userform auf mit weiterem Countdown (5 min). hier besteht aber die Möglichkeit den Countdown abzubrechen und weiter zu machen oder die Datei selbst zu schließen bzw. wird nach ablauf des CD die TabNelle automatisch geschlossen. wird wieder nichts innerhalb der tabelle gemacht läuft der CD erneut usw usw.

nur oft kommt es vor das es nach Ablauf der ersten 5 min zu einem Laufzeitfehler kommt.

Laufzeitfehler 400:
Formular wird bereits angezeigt und kann daher nicht gebunden werden

die Userform wird geöffnet aber ich kann nichts mehr machen und das Makro wird angehalten.

passiert nicht immer aber oft, woran kann das liegen?

hier meine Codes:

Arbeitsmappe
Code:

Option Explicit

Private mavntMonitoringSheets() As Variant

Private Sub Workbook_Open()

'prüfen ob Schreibschutz aktiev dann MsgBox
If ActiveWorkbook.ReadOnly = True Then
Dim Text1 As String
Dim Text2 As String
Dim Text3 As String
Dim Text4 As String
Text1 = "Die Datei ist schreibgeschützt geöffnet,"
Text2 = "bitte keine Fabrik-Nummern vergeben!!!"
Text3 = "Diese Datei schließt sich bei nicht Nutzen automatisch."
Text4 = "Diese Datei kann NICHT gespeichert werden!!!"
MsgBox Text1 & vbLf & Text2 & vbLf & Text3 & vbLf & Text4, , "ACHTUNG"

'wenn Schreibschutz gesamtes Tabellenblatt vor Bearbeitung sperren
ActiveSheet.UsedRange.Select
ActiveSheet.Unprotect
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Range("A1").Select

Zeitmakro ' Zeitmakro zur Anzeige der UserForm starten

End If

'für alle Blätter mit Passwortschutz
Dim ws As Worksheet
For Each ws In Worksheets
ws.Protect userinterfaceonly:=True
ws.EnableAutoFilter = True 'ermöglicht Autofilter
ws.EnableOutlining = True 'ermöglicht Gruppierung/Gliederung
Next ws

Dim wks As Worksheet
Dim imavntMonitoringSheets As Long

' zu überwachende Blätter ermitteln

Erase mavntMonitoringSheets

For Each wks In ThisWorkbook.Worksheets
Select Case wks.Name
Case "DummySheet1", "DummySheet2" ' Ausnahmen
Case Else
ReDim Preserve mavntMonitoringSheets(0 To imavntMonitoringSheets)
mavntMonitoringSheets(imavntMonitoringSheets) = wks.Name
imavntMonitoringSheets = imavntMonitoringSheets + 1
End Select
Next

End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Dim rngIntersect As Range
Dim rngArea As Range
Dim vntItem As Variant
Dim vntSheet As Variant

Dim lngIndex As Long

Dim strMonitoringAddress As String

If TypeOf Sh Is Worksheet Then

strMonitoringAddress = "I2:I" & Sh.Rows.Count ' zu überwachender Spaltenbereich

If IsNumeric(Application.Match(Sh.Name, mavntMonitoringSheets, 0)) Then

Set rngIntersect = Intersect(Target, Sh.Range(strMonitoringAddress))
If Not rngIntersect Is Nothing Then
With rngIntersect
For Each rngArea In rngIntersect.Areas
If rngArea.Rows.Count = 1 Then
vntItem = rngArea.Value
If Not IsEmpty(vntItem) Then
For Each vntSheet In mavntMonitoringSheets
If IsDuplikate(vntItem, vntSheet, strMonitoringAddress, vntSheet = Sh.Name) Then
MsgBox "Der Auftrag '" & vntItem & "' ist bereits in Tabellenblatt '" & vntSheet & "' enthalten! Bitte prüfen!", vbInformation, rngArea.Address

End If
Next
End If
Else
lngIndex = 0
For Each vntItem In rngArea.Value
lngIndex = lngIndex + 1
If Not IsEmpty(vntItem) Then
For Each vntSheet In mavntMonitoringSheets
If IsDuplikate(vntItem, vntSheet, strMonitoringAddress, vntSheet = Sh.Name) Then
MsgBox "Der Auftrag '" & vntItem & "' ist bereits in Tabellenblatt '" & vntSheet & "' enthalten! Bitte prüfen!", vbInformation, rngArea.Rows(lngIndex).Address
rngArea.Rows(lngIndex).ClearContents
End If
Next
End If
Next
End If
Next
Set rngArea = Nothing
End With
End If
Set rngIntersect = Nothing

End If

End If
'automatisches Speichern
If Selection.Row Target.Row Then
If ThisWorkbook.Saved = False Then
ThisWorkbook.Save
End If
End If
End Sub

Private Function IsDuplikate(ByVal vntSerachValue As Variant, _
ByVal strSheetName As String, _
ByVal strMonitoringAddress As String, _
ByVal blnActiveSheet) As Boolean
With ThisWorkbook.Worksheets(strSheetName).Range(strMonitoringAddress)
IsDuplikate = (WorksheetFunction.CountIf(.Cells, vntSerachValue) > Abs(blnActiveSheet))
End With
End Function

'beim Schließen wenn im Schreibschutz geöffnet kein Speichern
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Blatt As Object
If Me.ReadOnly = True And Me.Saved = False Then
On Error Resume Next ' Fehlerbehandlung ausschalten
' alle Makros stoppen
Application.OnTime EarliestTime:=DaEt, Procedure:="Start", Schedule:=False
Application.OnTime EarliestTime:=DaET1, Procedure:="Schließen", Schedule:=False
Application.OnTime EarliestTime:=DaET2, Procedure:="Zeitabstand", Schedule:=False
On Error GoTo 0 ' Fehlerbehandlung einschalten

Dim Text1 As String
Dim Text2 As String
Text1 = "Die Datei ist schreibgeschützt geöffnet"
Text2 = "und kann NICHT gespeichert werden!!!"
MsgBox Text1 & vbLf & Text2, , "ACHTUNG"
VBA.SendKeys "+N" 'Sendet Alt+N (Nein) an die Sicherheitsabfrage
End If

End Sub

'beim Speichern wenn im Schreibschutz geöffnet kein Speichern
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Me.ReadOnly = True And Me.Saved = False Then
Dim Text1 As String
Dim Text2 As String
Dim Text3 As String
Text1 = "Die Datei ist schreibgeschützt geöffnet"
Text2 = "und kann NICHT gespeichert werden!!!"
Text3 = "Bitte keine Fabrik-Nummern vergeben!!!"
MsgBox Text1 & vbLf & Text2 & vbLf & Text3, , "ACHTUNG"
VBA.SendKeys "+N" 'Sendet Alt+N (Nein) an die Sicherheitsabfrage
End If
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If ActiveWorkbook.ReadOnly = True Then
On Error Resume Next ' Fehlerbehandlung ausschalten
' Makro anhalten
Application.OnTime EarliestTime:=DaEt, Procedure:="Start", Schedule:=False
On Error GoTo 0 ' Fehlerebehandlung einschalten
If BoEnde = False Then Zeitmakro ' Zeitmakro zur Anzeige der UserForm starten
End If
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Tabelle
Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column < 7 Then 'wenn Spalte A-H
Target.Offset(0, 1).Select
' Eine Spalte weiter rechts springen
End If
If Target.Column = 7 Then 'wenn Spalte G
Target.Offset(0, 2).Select
' Zwei Spalten weiter rechts springen
End If
If Target.Column = 9 Then 'wenn Spalte I
Target.Offset(0, 1).Select
' Eine Spalte weiter rechts springen
End If
If Target.Column = 10 Then 'wenn Spalte J
Target.Offset(0, 2).Select
' Eine Spalte weiter rechts springen
End If
If Target.Column >= 11 And Target.Column

:)
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Chillor · 3. Februar 2016

konnte den Laufzeitfehler nun doch noch provoziert bekommen!
also wenn ich die Tabelle im schreibschutz öffne und mache darauf dort nicht, kommt der Fehler.
Öffne ich die Tabelle und Suche dort oder markiere was, was in der Regel ja auch passiert, funktioniert alles bestens.

kann ich nun den Fehler irgendwie übergehen, wenn die Tabelle geöffnet wird und man dort doch ncihts macht und vergisst sie selbst zu schließen?

Office: (Office 2010) Laufzeitfehler 400

Laufzeitfehler 400

Laufzeitfehler 400

Laufzeitfehler 400 - Similar Threads - Laufzeitfehler 400

VBA:Laufzeitfehler beim Einlesen in Variable

Datenbank bleibt gesperrt - laccdb wird nicht gelöscht

Access Laufzeitfehler 3048

Laufzeitfehler 9 VBA

VBA Laufzeitfehler 9

[VBA] .Documents.Open -> Laufzeitfehler 91

MS Access Lauftzeitfehler "2501"