Einbau Code in bestehenden
02.11.2023 12:43:14
chris1958
Ich möchte Euch um einen Gefallen bitten. Wie kann und wo muß ich diesen Code in meinen Gesamtcode einbinden, das dieser bei Aufruf des Formulars auf einmal läuft und ich nicht immer zuerst den einen und dann den anderen eintragen muß.
Hier der Code, der eingebaut werden soll:
Private Sub UserForm_Initialize()
ComboBox1.AddItem "Sonne/heisses Wetter"
ComboBox1.AddItem "Sonne/warm/klarer Himmel"
ComboBox1.AddItem "Sonne/warm/bewölkter Himmel"
ComboBox1.AddItem "Sonne/kalt/klarer Himmel"
ComboBox1.AddItem "Bewölkt/wenig Sonne"
ComboBox1.AddItem "Bewölkt/neblig/wenig Sonne"
ComboBox1.AddItem "Bewölkt/nebling/kalt"
ComboBox1.AddItem "Nebel/keine Sonne/Akku geleert"
Range("N19") = ComboBox1.Value
End Sub
und hier der bestehende Code, wo dieser gemeinsam sein soll:
Option Explicit
Private Sub CommandButton3_Click()
Dim StartZeile&
Dim Ws As Worksheet
Set Ws = ActiveSheet
StartZeile = Ws.Cells(3, 1).End(xlUp).Row + 5
TextBox1 = Int(Ws.Cells(StartZeile, 3) / 1000)
UserForm1.TextBox1.SetFocus
Ws.Cells(StartZeile + 1, 3) = TextBox3
End Sub
Private Sub CommandButton5_Click()
UserForm1.TextBox4.SetFocus
Range("C17").Value = CDbl(TextBox4.Text)
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub CommandButton4_Click()
If Not IsNumeric(TextBox4.Text) Then
MsgBox "PV Einspeisung eigeben - oder 0!" '---> Meldung
TextBox4.SetFocus '---> Textbox aktivieren
Exit Sub '---> Makro sofort beenden
UserForm1.TextBox4.SetFocus
End If
Range("C17").Value = CDbl(TextBox4.Text)
If Not IsNumeric(TextBox5.Text) Then
MsgBox "PV Eigenverbrauch eigeben - oder 0!" '---> Meldung
TextBox5.SetFocus '---> Textbox aktivieren
Exit Sub '---> Makro sofort beenden
UserForm1.TextBox5.SetFocus
End If
Range("C18").Value = CDbl(TextBox5.Text)
If Not IsNumeric(TextBox6.Text) Then
MsgBox "PV Eigenverbrauch eigeben - oder 0!" '---> Meldung
TextBox6.SetFocus '---> Textbox aktivieren
Exit Sub '---> Makro sofort beenden
UserForm1.TextBox6.SetFocus
End If
Range("C19").Value = CDbl(TextBox6.Text)
Dim StartZeile&
Dim Ws As Worksheet
Set Ws = ActiveSheet
StartZeile = Ws.Cells(3, 1).End(xlUp).Row + 5
Ws.Cells(StartZeile, 3) = CDbl(Format(TextBox1, "#,##0.00"))
Ws.Cells(StartZeile + 1, 3) = TextBox3
Dim i As Long
Const NewConstSheet As String = "Berechnung"
Dim bfound As Boolean
Dim sMerk As String
Dim sMaxZeile As Long
Dim TB As Worksheet
Application.ScreenUpdating = False
'Prüfen ob Tabelle NewConstSheet schon angelegt ist
For i = 1 To ActiveWorkbook.Sheets.Count
If ActiveWorkbook.Sheets(i).Name = NewConstSheet Then
bfound = True
Exit For
End If
Next i
'wenn nicht dann anlegen
If bfound = False Then
sMerk = ActiveWorkbook.ActiveSheet.Name
ActiveWorkbook.Sheets.Add after:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
ActiveWorkbook.ActiveSheet.Name = NewConstSheet
ActiveWorkbook.Sheets(sMerk).Activate
End If
Set TB = ActiveWorkbook.Sheets(NewConstSheet)
'nächste leere Zeile ermitteln
sMaxZeile = TB.Cells(TB.Rows.Count, 1).End(xlUp).Row + 1
'Daten in neue Tabelle übertragen
TB.Cells(sMaxZeile, 1) = ActiveWorkbook.ActiveSheet.Range("C7")
TB.Cells(sMaxZeile, 2) = ActiveWorkbook.ActiveSheet.Range("B7")
TB.Cells(sMaxZeile, 3) = ActiveWorkbook.ActiveSheet.Range("C6")
TB.Cells(sMaxZeile, 4) = ActiveWorkbook.ActiveSheet.Range("C12")
TB.Cells(sMaxZeile, 5) = ActiveWorkbook.ActiveSheet.Range("C13")
TB.Cells(sMaxZeile, 6) = ActiveWorkbook.ActiveSheet.Range("C14")
TB.Cells(sMaxZeile, 7) = ActiveWorkbook.ActiveSheet.Range("C15")
TB.Cells(sMaxZeile, 10) = ActiveWorkbook.ActiveSheet.Range("C17")
TB.Cells(sMaxZeile, 11) = ActiveWorkbook.ActiveSheet.Range("C18")
TB.Cells(sMaxZeile, 12) = ActiveWorkbook.ActiveSheet.Range("C19")
TB.Cells(sMaxZeile, 14) = ActiveWorkbook.ActiveSheet.Range("N19")
' Formel in Spalte H
TB.Cells(sMaxZeile, 8).FormulaR1C1 = "=(RC3-R[-1]C3)/(RC1-R[-1]C1)"
' Formel in Spalte I
TB.Cells(sMaxZeile, 9).FormulaR1C1 = "=(RC[-1])/24"
' Formel in Spalte L
TB.Cells(sMaxZeile, 13).FormulaR1C1 = "=TEXT(RC[-12],""TTTT"")"
Range("A2").Select
Application.ScreenUpdating = True
Unload Me '--- Userform schließen
End Sub
Ich möchte mich bereits jetzt für Eure Hilfe bedanken
chris