AW: Porjektnummer Formular in Tabelle speichern
17.10.2019 12:44:55
fcs
Hallo Martin,
hier das Gerüst für ein ensprechendes Makro.
Dateinamen, Zelladressen im Code muss du entsprechend anpassen.
LG
Franz
'Makro in der Formular-Datei in einem allgemeinen Modul
Sub prcSpeichern()
Dim wkbTabelle As Workbook, wksTab As Worksheet
Dim ZeileTab As Long, rngProj As Range
Dim bolEintragen As Boolean, bolOpen As Boolean
Dim wksFormular As Worksheet
Dim strDateiname As String
Dim strPfad As String
strDateiname = "Tabelle_Martin.xlsx" ''anpassen !
strPfad = ThisWorkbook.Path 'Verzeichnis anpassen wenn Formulardatei in anderem Verzeichnis _
als Tabellen-Datei
Set wksFormular = ThisWorkbook.Worksheets(1)
With wksFormular
'prüfen, ob Projektnummer im Formular eingetragen ist
If .Range("B3").Text = "" Then 'Zelle anpassen!
MsgBox "Im Formular ist keine Projektnummer eingetragen!", _
vbInformation + vbOKOnly, "Projektdaten speichern"
GoTo Beenden
End If
End With
'Prüfen, ob Tabellen-Datei schon geöffnet ist
For Each wkbTabelle In Application.Workbooks
If LCase(wkbTabelle.Name) = LCase(strDateiname) Then Exit For
Next
If wkbTabelle Is Nothing Then
'Tabellen-Datei öffnen
Set wkbTabelle = Application.Workbooks.Open( _
Filename:=strPfad & Application.PathSeparator & strDateiname)
bolOpen = False
Else
bolOpen = True
End If
If wkbTabelle.ReadOnly = True Then
MsgBox "Die Datei """ & strDateiname _
& """ wird zur Zeit von einem anderen User verwendet." & vbLf _
& "Datei wird wieder geschlossen" & vbLf _
& "Speichern später nochmals versuchen", vbOKOnly, "Projektdaten speichern"
wkbTabelle.Close savechanges:=False
GoTo Beenden
End If
Set wksTab = wkbTabelle.Worksheets(1)
With wksTab
bolEintragen = True
'projektnummer in Spalte A suchen - 'Zelle mit Projekt-Nummer ggf. _
anpassen!
Set rngProj = .Range("A:A").Find(What:=wksFormular.Range("B3").Value, _
LookIn:=xlValues, lookat:=xlWhole)
If rngProj Is Nothing Then
'Nummer der nächsten leeren Zeile
ZeileTab = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(ZeileTab, 1) = wksFormular.Range("B3").Value 'Projekt - 'Zelle ggf. anpassen! _
Else
If MsgBox("Projekt-Nr. ist in Datei """ & wkbTabelle.Name _
& """ bereits vorhanden!" & vbLf & vbLf _
& "Daten überschreiben?", _
vbQuestion + vbYesNo + vbDefaultButton2, _
"Projektdaten speichern") = vbNo Then
bolEintragen = False
Else
ZeileTab = rngProj.Row
End If
End If
If bolEintragen = True Then
.Cells(ZeileTab, 2) = wksFormular.Range("B5").Value 'Datum - 'Zelle ggf. anpassen!
.Cells(ZeileTab, 3) = wksFormular.Range("B7").Value 'Projektleiter - 'Zelle ggf. _
anpassen!
wkbTabelle.Save
End If
If bolOpen = False Then wkbTabelle.Close savechanges:=True
ThisWorkbook.Activate
End With
Beenden:
End Sub