Speicher Macro

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

Informationen und Beispiele zum Thema CheckBox
Screenshot zu CheckBox	CheckBox-Seite mit Beispielarbeitsmappe aufrufen

Informationen und Beispiele zum Thema MsgBox
Screenshot zu MsgBox	MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Informationen und Beispiele zum Thema CommandButton
Screenshot zu CommandButton	CommandButton-Seite mit Beispielarbeitsmappe aufrufen

Informationen und Beispiele zum Thema Userform
Screenshot zu Userform	Userform-Seite mit Beispielarbeitsmappe aufrufen

Informationen und Beispiele zum Thema ListBox
Screenshot zu ListBox	ListBox-Seite mit Beispielarbeitsmappe aufrufen

Informationen und Beispiele zum Thema TextBox
Screenshot zu TextBox	TextBox-Seite mit Beispielarbeitsmappe aufrufen

Informationen und Beispiele zum Thema ToggleButton
Screenshot zu ToggleButton	ToggleButton-Seite mit Beispielarbeitsmappe aufrufen

Speicher Macro

Speicher Macro von Vulferin vom 06.09.2014 16:48:33

AW: Speicher Macro - von fcs am 06.09.2014 17:18:20
- AW: Speicher Macro - von Vulferin am 06.09.2014 17:30:12
  - AW: Speicher Macro - von fcs am 06.09.2014 18:52:59
    - AW: Speicher Macro - von Vulferin am 07.09.2014 00:27:01
      - AW: Speicher Macro - von Vulferin am 07.09.2014 01:41:57
        
        AW: Speicher Macro - von Vulferin am 07.09.2014 01:53:51
        
        AW: Speicher Macro - von fcs am 07.09.2014 08:30:49
        
        AW: Speicher Macro - von Vulferin am 07.09.2014 09:10:56
        
        AW: Speicher Macro - von Vulferin am 07.09.2014 09:48:07

Betrifft: Speicher Macro von: Vulferin
Geschrieben am: 06.09.2014 16:48:33

Hallo zusammen
Leider kann ich in meinem Alten Beitrag nix mehr schreiben. War wohl zu lange nich tmehr Online
ich habe folgendes Speichern Macro

Private Sub CommandButton3_Click()
   Dim lZeile As Long
     If ListBox1.ListIndex = -1 Then Exit Sub
     If Trim(CStr(TextBox1.Text)) = "" Then
         MsgBox "Sie mÙssen mindestens einen Namen eingeben!", vbCritical + vbOKOnly, "FEHLER!"
         Exit Sub
     End If

     lZeile = 2
     Do While Trim(CStr(Tabelle1.Cells(lZeile, 1).Value)) <> ""
         If ListBox1.Text = Trim(CStr(Tabelle1.Cells(lZeile, 1).Value)) Then
             Tabelle1.Cells(lZeile, 1).Value = Trim(CStr(TextBox1.Text))
             Tabelle1.Cells(lZeile, 2).Value = TextBox2.Text
             Tabelle1.Cells(lZeile, 3).Value = TextBox3.Text
             Tabelle1.Cells(lZeile, 4).Value = TextBox4.Text
             Tabelle1.Cells(lZeile, 5).Value = TextBox5.Text
             Tabelle1.Cells(lZeile, 6).Value = TextBox6.Text
             Tabelle1.Cells(lZeile, 7).Value = TextBox7.Text
             Tabelle1.Cells(lZeile, 8).Value = TextBox8.Text
             Tabelle1.Cells(lZeile, 9).Value = TextBox9.Text
             Tabelle1.Cells(lZeile, 10).Value = CheckBox1
             Tabelle1.Cells(lZeile, 11).Value = TextBox11.Text
             Tabelle1.Cells(lZeile, 12).Value = CheckBox2
             Tabelle1.Cells(lZeile, 13).Value = TextBox13.Text
             Tabelle1.Cells(lZeile, 14).Value = CheckBox3
             Tabelle1.Cells(lZeile, 15).Value = TextBox15.Text
             Tabelle1.Cells(lZeile, 16).Value = CheckBox4
             Tabelle1.Cells(lZeile, 17).Value = TextBox17.Text
             Tabelle1.Cells(lZeile, 18).Value = TextBox18.Text
             Tabelle1.Cells(lZeile, 19).Value = TextBox19.Text
            
     
             If ListBox1.Text <> Trim(CStr(TextBox1.Text)) Then
                 Call UserForm_Initialize
                 If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
             End If
            
             Exit Do
            
         End If
    
         lZeile = lZeile + 1
     Loop

ICh würde das gerne mit diesem Code Kompinieren

Dim a As Variant Dim wksSuch As Worksheet Dim wksZiel As Worksheet Set wksSuch = Worksheets("Gebiete") Set wksZiel = Worksheets("Tabelle1") 'ZielBlattName anpassen If IsNumeric(TextBox8) Then 'wenn Zahl in Textbox a = Application.Match(CLng(TextBox8), wksSuch.Columns(1), 0) If IsNumeric(a) Then 'wenn Zahl gefunden wksZiel.Range("H1").Value = wksSuch.Cells(a, 2).Value Else 'wenn zahl nicht gefunden MsgBox "Nr. nicht vorhanden" End If Else ' wenn keine Zahl in Textbox wksZiel.Range("H1") = TextBox8 End If Set wksSuch = Nothing Set wksZiel = Nothing End Sub

Jetzt ist das ja so, das ich in Spalte H wo er mit das gesuchte aus Gebiete reinschreiben soll mehrere Zeilen habe
Diese habe ich in einer Listenbox
Wenn ich also diese scuhe mache.
Sollte er die aktive Zeile finden und dort in H das gesuchte eintragen
ich bekomme das irgendwie nicht hin ;(

Betrifft: AW: Speicher Macro von: fcs
Geschrieben am: 06.09.2014 17:18:20

Hallo Vulferin,

aus deiner Fragestellung erkenne ich leider nicht was genau dein Problem ist.

Wenn du die gewählten Einträge eine Listbox mit Mehrfachauswahl auswerten willst, dann kannst du das z.B. wie folgt machen:

    Dim strText As String, intC As Integer, strTrenn As String
    strTrenn = vbLf 'Trenntext zwischen Listenzeilen
    With Listbox1 'Listbox mit Mehrfachauswahl
        For intC = 0 To .ListCount
            If .Selected(intC) = True Then
                If strText = "" Then
                    strText = .List(intC, 0)
                Else
                    strText = strText & strTrenn & .List(intC, 0)
                End If
            End If
        Next
    End With

möchtest du alle Einträge in der Listbox in eine Variable übernehmen, dann die
If .Selected(intC) = True Then
inkl. des zugehörigen End If weglassen.
Die Variable weist du dann der gewünschten Zelle in Spalte H zu.

Gruß
Franz

Betrifft: AW: Speicher Macro von: Vulferin
Geschrieben am: 06.09.2014 17:30:12

Das verstehe ich gar nicht

Ich würde das gerne so haben
das ich in Spalte H eine Zahl oder ein Name eintragen kann.
Bei Namen soll er gar nix machen
wenn es eine Zahl ist soll er vor dem Übertragen in die Zelle
Auf dem Blatt Gebiete nach der Zahl in Spalte 1 Suchen und dann den Wert aus Spalte 2 in die Zelle Übertragen
So das ich in der Zelle immer einen Name drin stehen habe.

Betrifft: AW: Speicher Macro von: fcs
Geschrieben am: 06.09.2014 18:52:59

Hallo Vulferin,

da gab es dann wohl ein Mißverständnis durch die unklare Fragestellung.
Die Ermittlung und das Eintragen des Werte sin Spalte H lagerst du am besten in eine separtae kleine Sub aus, der als Parameter die Zelle übergeben wird in die der ermittelte Wert eingetragen werden soll.

Gruß
Franz

Private Sub CommandButton3_Click()
'...
    'Tabelle1.Cells(lZeile, 8).Value = TextBox8.Text  'diese Zeile durch die folgende ersetzen
    Call prcFill_SpalteH(ZelleZiel:=Tabelle1.Cells(lZeile, 8))  'ZielBlattName anpassen
'...
End Sub


Sub prcFill_SpalteH(ZelleZiel As Range)
    'Wert in Textbox8 verarbeiten, bei Zahl den zugehörigen Namen aus Blatt "Gebiete" in  _
Zielzelle eintragen
    Dim a As Variant
    Dim wksSuch As Worksheet
    Set wksSuch = Worksheets("Gebiete")
    With ZelleZiel
        If IsNumeric(TextBox8) Then 'wenn Zahl in Textbox
            a = Application.Match(CLng(TextBox8), wksSuch.Columns(1), 0)
            If IsNumeric(a) Then 'wenn Zahl gefunden
                .Value = wksSuch.Cells(a, 2).Value
            Else 'wenn zahl nicht gefunden
                .ClearContents
                MsgBox "Nr. nicht vorhanden"
            End If
        Else ' wenn keine Zahl in Textbox
            .Value = TextBox8
        End If
    End With
    Set wksSuch = Nothing
End Sub

Betrifft: AW: Speicher Macro von: Vulferin
Geschrieben am: 07.09.2014 00:27:01

irgendie sagt er mir immer Nr nicht gefunden.
d.H er findet die Nr nicht im Blatt Gebiete.
Ich weiss nicht ob er richtig sucht

Betrifft: AW: Speicher Macro von: Vulferin
Geschrieben am: 07.09.2014 01:41:57

Habs hin bekommen.
Aber nun eine Frage
Wenn ich einen neuen eintrag mache
fülle ich über die Textbox die leere Zelle
Cells(lngErsteFreie, 11).Value = TextBox11
wie kann ich da dein Macro mit einbauen ?

Betrifft: AW: Speicher Macro von: Vulferin
Geschrieben am: 07.09.2014 01:53:51

Ich bekomm das nicht hin
Wenn ich einen bestehenden Listenbox beitrag änder und speicher klappt das.
Bei einem neuen bekomm ich das nicht hin :(

Betrifft: AW: Speicher Macro von: fcs
Geschrieben am: 07.09.2014 08:30:49

Hallo Vulferin,

du hast ja jetzt nicht verraten, was das Problem beim suchen der Nr im Blatt "Gebiete" war bzw. wie du es gelöst hast. Ich hab das Makro jetzt mal so geändert das Zahlenfolgen in den Textboxen gefunden werden unabhängig davon, ob sie in den Zellen als Zahl oder Text stehen.

Damit das Makro für 2 Textboxen zur Suche eines Namens benutzt werden kann hab den Wert der Textbox als zusätzlichen Parameter ergänzt.

Gruß
Franz

Private Sub CommandButton3_Click()
'...
    'Tabelle1.Cells(lZeile, 8).Value = TextBox8.Text  'diese Zeile durch die folgende ersetzen
'Datensatz - Ändern
    Call prcFill_SpalteH(ZelleZiel:=Tabelle1.Cells(lZeile, 8), _
         varTextbox:=TextBox8.Value) 'ZielBlattName anpassen
'...
'Datensatz - Neu
'...    
    Call prcFill_SpalteH(ZelleZiel:=Tabelle1.Cells(lngErsteFreie, 8), _
         varTextbox:=TextBox11.Value)
End Sub


Sub prcFill_SpalteH(ZelleZiel As Range, varTextbox As Variant)
    'Wert in Textbox verarbeiten, bei Zahl den zugehörigen Namen aus Blatt "Gebiete" in _
Zielzelle eintragen
    Dim a As Variant, b As Variant
    Dim wksSuch As Worksheet
    Set wksSuch = Worksheets("Gebiete")
    With ZelleZiel
        If IsNumeric(varTextbox) Then 'wenn Zahl in Textbox
            a = Application.Match(CLng(varTextbox), wksSuch.Columns(1), 0)
            b = Application.Match(varTextbox, wksSuch.Columns(1), 0)
            If IsNumeric(a) Then 'wenn Zahl gefunden
                .Value = wksSuch.Cells(a, 2).Value
            ElseIf IsNumeric(b) Then
                .Value = wksSuch.Cells(b, 2).Value
            Else 'wenn zahl nicht gefunden
                .ClearContents
                MsgBox "Nr. nicht vorhanden"
            End If
        Else ' wenn keine Zahl in Textbox
            .Value = varTextbox
        End If
    End With
    Set wksSuch = Nothing
End Sub

Betrifft: AW: Speicher Macro von: Vulferin
Geschrieben am: 07.09.2014 09:10:56

Hallo FCS
Ich hab das so gelöst
ich weiss das da was doppelt drin ist.
aber es geht

'Speichern Schaltfl_che Ereignisroutine
Private Sub CommandButton3_Click()
   Dim lZeile As Long
   Dim lngZeile As Long
        With ListBox1
            lngZeile = .List(.ListIndex, 1)
        End With
     If ListBox1.ListIndex = -1 Then Exit Sub
     If Trim(CStr(TextBox1.Text)) = "" Then
         MsgBox "Sie mÙssen mindestens einen Namen eingeben!", vbCritical + vbOKOnly, "FEHLER!"
         Exit Sub
     End If

     lZeile = 2
     Do While Trim(CStr(Tabelle1.Cells(lngZeile, 1).Value)) <> ""
         If ListBox1.Text = Trim(CStr(Tabelle1.Cells(lngZeile, 1).Value)) Then
             Tabelle1.Cells(lngZeile, 1).Value = Trim(CStr(TextBox1.Text))
             Tabelle1.Cells(lngZeile, 2).Value = TextBox2.Text
             Tabelle1.Cells(lngZeile, 3).Value = TextBox3.Text
             Tabelle1.Cells(lngZeile, 4).Value = TextBox4.Text
             Tabelle1.Cells(lngZeile, 5).Value = TextBox5.Text
             Tabelle1.Cells(lngZeile, 6).Value = TextBox6.Text
             Tabelle1.Cells(lngZeile, 7).Value = TextBox7.Text
             Call prcFill_SpalteH(ZelleZiel:=Tabelle1.Cells(lngZeile, 8))
             Tabelle1.Cells(lngZeile, 9).Value = TextBox9.Text
             Tabelle1.Cells(lngZeile, 10).Value = CheckBox1
             Tabelle1.Cells(lngZeile, 11).Value = TextBox11.Text
             Tabelle1.Cells(lngZeile, 12).Value = CheckBox2
             Tabelle1.Cells(lngZeile, 13).Value = TextBox13.Text
             Tabelle1.Cells(lngZeile, 14).Value = CheckBox3
             Tabelle1.Cells(lngZeile, 15).Value = TextBox15.Text
             Tabelle1.Cells(lngZeile, 16).Value = CheckBox4
             Tabelle1.Cells(lngZeile, 17).Value = TextBox17.Text
             Tabelle1.Cells(lngZeile, 18).Value = TextBox18.Text
             Tabelle1.Cells(lngZeile, 19).Value = TextBox19.Text
            
     
             If ListBox1.Text <> Trim(CStr(TextBox1.Text)) Then
                 Call UserForm_Initialize
                 If ListBox1.ListCount > 0 Then ListBox1.ListIndex = 0
             End If
            
             Exit Do
            
         End If
    
       lZeile = lZeile + 1
   Loop
    
End Sub

das klappt jetzt
Nun hab ich aber das Problem das ich diese suche auch bei einem Neuen eintrag den ich machen nutzen will

Hier der Code für den neuen eintrag

  Private Sub CommandButton1_Click()
        Dim lngErsteFreie As Long
        Dim intSpalte As Integer
        Dim i As Integer
       
        If CommandButton1.Caption = "Neuer Eintrag" Then
            For i = 1 To 9
                Controls("Textbox" & i) = ""
            Next
            TextBox11 = ""
            TextBox13 = ""
            TextBox15 = ""
            For i = 17 To 19
                Controls("Textbox" & i) = ""
            Next
            For i = 1 To 4
                Controls("Checkbox" & i) = False
            Next
            CommandButton1.Caption = "Neuer Eintrag Speichern"
            CommandButton1.Enabled = False
            CommandButton2.Enabled = False
            CommandButton3.Enabled = False
            CommandButton4.Enabled = False
            ToggleButton1.Enabled = False
            ToggleButton2.Enabled = False
            ToggleButton3.Enabled = False
        Else
            lngErsteFreie = Cells(Rows.Count, "A").End(xlUp).Row + 1
            For intSpalte = 1 To 9
                Cells(lngErsteFreie, intSpalte).Value = Controls("TextBox" & intSpalte)
            Next
            Cells(lngErsteFreie, 10).Value = CheckBox1
            Cells(lngErsteFreie, 11).Value = TextBox11
            Cells(lngErsteFreie, 12).Value = CheckBox2
            Cells(lngErsteFreie, 13).Value = TextBox13
            Cells(lngErsteFreie, 14).Value = CheckBox3
            Cells(lngErsteFreie, 15).Value = TextBox15
            Cells(lngErsteFreie, 16).Value = CheckBox4
            For intSpalte = 17 To 19
                Cells(lngErsteFreie, intSpalte).Value = Controls("TextBox" & intSpalte)
            Next
            CommandButton1.Caption = "Neuer Eintrag"
            CommandButton1.Enabled = True
            CommandButton2.Enabled = True
            CommandButton3.Enabled = True
            CommandButton4.Enabled = True
            ToggleButton1.Enabled = True
            ToggleButton2.Enabled = True
            ToggleButton3.Enabled = True
            Call UserForm_Initialize
        End If
    End Sub

das bekomme ich aber nicht hin
er speicher mir die Zahl wenn ich dann diese Zeile in der ListBox wieder aktiveren und auf Speichern klicke nimmt er dein macro

Betrifft: AW: Speicher Macro von: Vulferin
Geschrieben am: 07.09.2014 09:48:07

Es klappt Danke dir :)
Du bist genial

Meine Liste ist geil
Jetzt muss ich noch hin bekommen das wenn ich auf CommandoButton9 Klicke
er ein Screenshot von der Userform schickt
Ich Anhand Arbeitsblatt Monteure den namen auswählen kann
er dann spalte daneben die Emailadresse nimmt
und den Screenshot am besten per pdf oder jpg per email versendet
geht sowas ?