Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema CheckBox
BildScreenshot zu CheckBox CheckBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema CommandButton
BildScreenshot zu CommandButton CommandButton-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Userform
BildScreenshot zu Userform Userform-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema ListBox
BildScreenshot zu ListBox ListBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema TextBox
BildScreenshot zu TextBox TextBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema ToggleButton
BildScreenshot zu ToggleButton ToggleButton-Seite mit Beispielarbeitsmappe aufrufen

Speicher Macro

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 ?


     

    Beiträge aus den Excel-Beispielen zum Thema "Speicher Macro"