Hallo Forum,
ich hoffe Ihr könnt mir weiterhelfen. :-)
Ich habe folgendes Problem:
Im Unternehmen gibt es für die Kalkulation von Angebotspreisen ein Excel-Formular.
Dieses soll mit einer laufenden Nr. in einer externen Datenbank gespeichert und wieder in das Formular gebracht werden können. Das funktioniert auch soweit.
Zum Problem:
Das Formular wird zeitgleich von mehreren Nutzern genutzt (teilweise im Schreibschutz), so das es bei der Vergabe von laufenden Nr. zu Fehlermeldungen teilweise kommt.
vielleicht habt ihr eine Idee wie man das Problem lösen könnte. Für Anregungen wäre ich sehr dankbar.
Anbei der Quellcode der VBA Anwendung:
Dim a As String
a = MsgBox("Möchten Sie eine neue Kalkulation speichern?", vbYesNo, "NEUE KALKULATION SPEICHERN")
If a = vbYes Then
Application.ScreenUpdating = False
ActiveSheet.Unprotect
Range("BF51:BI51").Select
ActiveCell.FormulaR1C1 = "='G:\[Datenbank.xlsx]Tabelle2'!R1C1"
Range("BB42").Select
ActiveCell.FormulaR1C1 = "=R[9]C[4]+1"
Range("BF42").Value = "1"
'Erhöhen der laufenden Nummer
Workbooks.Open Filename:="G:\Datenbank.xlsx"
' Öffnen der Datenbank
Rows("2:2").Select
Selection.Insert Shift:=xlDown
Rows("2:2").EntireRow.AutoFit
' Einfügen einer neuen Zeile
Windows("KalkulationAngebote.xlsm").Activate
Sheets("Datensatz").Select
'Öffenen Tabellenblatt Datensatz
Rows("2:2").Select
Selection.Copy
Windows("Datenbank.xlsx").Activate
Rows("2:2").Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
'Einfügen in Datenbank
Range("A2").Select
Application.CutCopyMode = False
ActiveWorkbook.Save
'Datenbank speichern
ActiveWindow.Close
'Datenbank schließen
Sheets("NEU").Select
Range("BF51").Select
Selection.Copy
Range("BB42").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("W1").Select
MsgBox "Der Datensatz wurde in der Datenbank als laufende Nummer " & Range("BB42").Text & " " & "gespeichert.", , ""
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowInsertingRows:=True, AllowDeletingRows _
:=True
End If
End Sub