Files
elwig-misc/wgmaster/vba/Form_FSortenkuerzelUmbenennen.frm
2022-11-14 23:29:49 +01:00

130 lines
3.4 KiB
Plaintext

Private Sub BUmbenennen_Click()
DoCmd.Hourglass True
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
SortenKuerzelUmbenennen
DoCmd.Hourglass False
DoCmd.Close
Forms!FSorten.Requery
End Sub
Private Sub Form_Open(Cancel As Integer)
TempTabelleAnlegen
Forms!FSortenkuerzelUmbenennen.RecordSource = "xTempSortenkuerzelumbenennen"
Requery
End Sub
Sub TempTabelleAnlegen()
Dim db1 As Database
Dim rs1 As Recordset
Dim rs2 As Recordset
Set db1 = CurrentDb
If TableExists("xTempSortenkuerzelUmbenennen") Then
db1.Execute ("drop table xTempSortenkuerzelUmbenennen")
End If
db1.Execute ("Create table xTempSortenkuerzelUmbenennen (SNRAlt TEXT, BezeichnungAlt TEXT, kgprohaalt DOUBLE,typalt TEXT, SNRNeu TEXT, BezeichnungNeu TEXT, kgprohaneu DOUBLE, typneu TEXT)")
db1.Execute ("delete * from xTempSortenkuerzelumbenennen")
Set rs1 = db1.OpenRecordset("SELECT * FROM TSorten")
Set rs2 = db1.OpenRecordset("xTempSortenkuerzelumbenennen")
While Not rs1.EOF
rs2.AddNew
rs2!SNRAlt = rs1!SNR
rs2!SNRNeu = rs1!SNR
rs2!BezeichnungAlt = rs1!Bezeichnung
rs2!Bezeichnungneu = rs1!Bezeichnung
rs2!kgprohaneu = rs1!KgProHa
rs2!kgprohaalt = rs1!KgProHa
rs2!Typalt = rs1!Typ
rs2!Typneu = rs1!Typ
rs2.Update
rs1.MoveNext
Wend
rs1.Close
rs2.Close
End Sub
Sub SortenKuerzelUmbenennen()
Dim db1 As Database
Dim rs1 As Recordset
Dim rs2 As Recordset
Set db1 = CurrentDb
Set rs1 = db1.OpenRecordset("SELECT * from xTempSortenkuerzelUmbenennen ORDER BY SNRAlt")
'1. Alle Sorten von alt auf neu mit n als Präfix
While Not rs1.EOF
'TAuszahlungSorten
db1.Execute ("UPDATE TAuszahlungSorten SET SNR='n" + rs1!SNRNeu + "' WHERE SNR='" + Format(rs1!SNRAlt) + "'")
'TFlaechenbindungen
db1.Execute ("UPDATE TFlaechenbindungen SET SNR='n" + rs1!SNRNeu + "' WHERE SNR='" + Format(rs1!SNRAlt) + "'")
'TLieferungen
db1.Execute ("UPDATE TLieferungen SET SNR='n" + rs1!SNRNeu + "' WHERE SNR='" + Format(rs1!SNRAlt) + "'")
'TSorten
db1.Execute ("UPDATE TSorten SET SNR='n" + rs1!SNRNeu + "',kgproha=" + Format(rs1!kgprohaneu) + " WHERE SNR='" + Format(rs1!SNRAlt) + "'")
rs1.MoveNext
Wend
rs1.Close
'2. Bei allen Sorten den Präfix n entfernen
Set rs1 = db1.OpenRecordset("SELECT DISTINCT SNRNeu from xTempSortenkuerzelUmbenennen ORDER BY SNRNeu")
db1.Execute ("DELETE * FROM TSorten")
Set rs2 = db1.OpenRecordset("TSorten")
While Not rs1.EOF
'TAuszahlungSorten
db1.Execute ("UPDATE TAuszahlungSorten SET SNR='" + rs1!SNRNeu + "' WHERE SNR='n" + rs1!SNRNeu + "'")
'TFlaechenbindungen
db1.Execute ("UPDATE TFlaechenbindungen SET SNR='" + rs1!SNRNeu + "' WHERE SNR='n" + rs1!SNRNeu + "'")
'TLieferungen
db1.Execute ("UPDATE TLieferungen SET SNR='" + rs1!SNRNeu + "' WHERE SNR='n" + rs1!SNRNeu + "'")
'TSorten
' db1.Execute ("UPDATE TSorten SET SNR='" + rs1!SNRneu + "' WHERE SNR='n" + rs1!SNRneu + "'")
rs2.AddNew
rs2!SNR = rs1!SNRNeu
rs2!KgProHa = DFirst("kgprohaneu", "xTempSortenkuerzelUmbenennen", "SNRNeu='" + rs1!SNRNeu + "'")
rs2!Bezeichnung = DFirst("Bezeichnungneu", "xTempSortenkuerzelUmbenennen", "SNRNeu='" + rs1!SNRNeu + "'")
rs2!Typ = DFirst("typneu", "xTempSortenkuerzelUmbenennen", "SNRNeu='" + rs1!SNRNeu + "'")
rs2.Update
rs1.MoveNext
Wend
rs1.Close
End Sub
Function TableExists(table1) As Boolean
Dim db1 As Database
Set db1 = CurrentDb
Dim x As TableDef
For Each x In db1.TableDefs
If x.Name = table1 Then
TableExists = True
Exit Function
End If
Next x
TableExists = False
End Function