AW: In Deinem Beispiel nicht, aber ...
27.05.2017 16:29:22
Lumila
Hallo Matthias,
nachfolgend der Code wo der Fehler erscheint.
Public Declare PtrSafe
Function ShowCursor Lib "user32.dll" (ByVal bShow As Long) As Long
Public Declare
Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Dim wD as Object, wBL as Object, obj as Object
Dim sBL $
Dim lFZNRfind&, lSp as long
Sub BL_speichern()
Set wD = Workbooks(sD): Set wBL = wD.Worksheets(sBL) ' Workbook und die Tabelle
With wBL ' Die Tabelle Bauleitung
If lZNRfind > 0 Then GoTo Step1 ' Wenn BL bearbeitet wurde damit nicht neu eingetragen
If .Cells(2, 1) = "" Then 'Wenn noch nichts eingetragen wurde
lZNRfind = 2
Else
lZNRfind = .Cells(Rows.Count, 1).End(xlUp).Row + 1
End If
End With
Step1:
With UF1 'hier werden die CommandButton 1 - 7 ausgeblendet die sich im Frame "fraUF1" _
befinden
For Each obj In .fraUF1.Controls
Select Case TypeName(obj)
Case "CommandButton": obj.Visible = False
End Select: Next obj
.fraUF1.BackColor = 49152 'grün Der Frame wird von blau auf grün geändert
.lblUFTitel.Visible = False ' Das Label welches die Bezeichnung Bauleitung angibt wird _
ausgeblendet das Label "lblSpTitel" wird eingeblendet
With .lblSpTitel: .ForeColor = 16777215: .BackColor = 49152: .Top = 12: .Height = 18: . _
Width = UF1.fraUF1.Width - 10: .Left = 5: .Caption = "Die Bauleiterdaten werden gespeichert....": .Visible = True: End With
End With
DoEvents 'Sonst keine Anzeige des Label
Call ShowCursor(0) 'Der Mousepointer wird ausgeschaltet, es sollen keine Änderungen in _
der Userform während des Speicherns erfolgen
Call Sleep(1000) 'sonst geht es zu schnell
On Error GoTo Aus 'Bei Fehler
With wBL 'Tabellenblatt mit Daten aus Userform füllen
lSp = Application.Match("ID", .Rows(1), 0): .Cells(lZNRfind, lSp) = lZNRfind
lSp = Application.Match("KDNR", .Rows(1), 0): .Cells(lZNRfind, lSp) = UF1.txtBL1.Value
lSp = Application.Match("NACHNAME", .Rows(1), 0): .Cells(lZNRfind, lSp) = UF1.txtBL2. _
Value
lSp = Application.Match("VORNAME", .Rows(1), 0): .Cells(lZNRfind, lSp) = UF1.txtBL3.Value
lSp = Application.Match("MOBIL", .Rows(1), 0): .Cells(lZNRfind, lSp).NumberFormat = "@": . _
Cells(lZNRfind, lSp) = UF1.txtBL4.Value
lSp = Application.Match("TELEFON", .Rows(1), 0): .Cells(lZNRfind, lSp).NumberFormat = "@": _
.Cells(lZNRfind, lSp) = UF1.txtBL5.Value
lSp = Application.Match("MAIL", .Rows(1), 0): .Cells(lZNRfind, lSp) = UF1.txtBL6.Value
lSp = Application.Match("NOTIZ", .Rows(1), 0): .Cells(lZNRfind, lSp) = UF1.txtBL7.Value
lSp = Application.Match("NAMEKOMPLETT", .Rows(1), 0)
If UF1.txtBL3.Value "" Then 'Wenn bei Bauleiter Vor und Nachname eingetragen ist
.Cells(lZNRfind, lSp) = UF1.txtBL2.Value & " " & UF1.txtBL3.Value
Else
.Cells(lZNRfind, lSp) = UF1.txtBL2.Value 'Nur mit Nachnamen
End If
lSp = Application.Match("ANREDE", .Rows(1), 0): .Cells(lZNRfind, lSp) = UF1.cboBL2.Value
lSp = Application.Match("TITEL", .Rows(1), 0): .Cells(lZNRfind, lSp) = UF1.cboBL3.Value
lSp = Application.Match("POSITION", .Rows(1), 0): .Cells(lZNRfind, lSp) = UF1.cboBL4. _
Value
lSp = Application.Match("BRIEF", .Rows(1), 0): .Cells(lZNRfind, lSp) = UF1.cboBL5.Value
loEnde = .Cells(Rows.Count, 1).End(xlUp).Row 'sortieren
lSp = .Cells(1, Columns.Count).End(xlToLeft).Column
Range(.Cells(1, 1), .Cells(loEnde, lSp)).Sort _
Key1:=.Range("C1"), Order1:=xlAscending, _
Header:=xlYes, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
For ii = 2 To loEnde 'Neue ID Nummer zuordnen
.Cells(ii, 1) = ii
Next ii
.Columns.AutoFit
End With
' Call BL_lsv_vorbereiten 'Hier werden die ColumnHeaders.Add eingerichtet
' Call BL_lsv_einlesen 'Hier wird die ListView eingelesen
With UF1 'Jetzt kommt der Teil wo die Fehelrmeldung erscheint, ´wenn ich die Locked _
vor setzte
For Each obj In .Controls
Select Case TypeName(obj)
Case "TextBox"
If obj.Name "txtBLAnz" Then: obj.Locked = True: obj.Value = ""
Case "ComboBox"
If obj.Name "cboBL1" Then: obj.Locked = True: obj.ListIndex = -1
End Select: Next obj
.cmd3.Visible = False
End With
Workbooks(sD).Save ' ausgeblendete Mappe speichern
DoEvents ' wieder damit Text im Label angezeigt wird
With UF1
iZeit = 2
For ii = 1 To 4
Call Sleep(999)
With .lblSpTitel: .ForeColor = 16777215: .Caption = "Die Speicherung der Bauleiterdaten _
wurde abgeschlossen...( Diese Medung endet in " & iZeit & " sec. )": End With
iZeit = iZeit - 1
DoEvents
Next ii
.lblSpTitel.Visible = False
.fraUF1.BackColor = 16711680 'blau
.lblUFTitel.Visible = True
End With
Call Auswahl_speichern_anlegen 'Hier werden die Button wieder eingeblendet
Call ShowCursor(1)
lZNRfind = 0
UF1.txtruhe.SetFocus
Aus:
Set wD = Nothing: Set wData = Nothing
If Err.Number 0 Then MsgBox "Error: " & Err.Number & " " & Err.Description
End Sub
Vielleicht ist im Code ein Fehler.
Lg
Ludmila