Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema InputBox
Screenshot zu InputBox	InputBox-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

Abfragebox per Makro

• Abfragebox per Makro von gelee93 vom 19.09.2019 09:51:39
• AW: Abfragebox per Makro - von Bernd am 19.09.2019 12:49:30
• AW: Abfragebox per Makro - von ChrisL am 19.09.2019 12:54:13
• AW: Abfragebox per Makro - von gelee93 am 19.09.2019 14:10:13
• AW: Abfragebox per Makro - von ChrisL am 19.09.2019 14:39:37
• AW: Abfragebox per Makro - von gelee93 am 19.09.2019 14:05:10
• AW: Abfragebox per Makro - von gelee93 am 19.09.2019 14:44:55
• AW: Abfragebox per Makro - von gelee93 am 19.09.2019 14:45:53

Betrifft: Abfragebox per Makro von: gelee93
Geschrieben am: 19.09.2019 09:51:39

Hallo Zusammen,

ich habe mit eurer Hilfe ein Makro zusammenbekommen, dass eine Zeile inklusive der Formeln in alle Tabellenblätter der Mappe einfügt.
Nun wäre es noch praktisch, wenn bei der Ausführung des Makros eine Abfrage erscheint, wie viele Zeilen eingefügt werden sollen.

Ich stelle mir das so vor, dass ein Fenster aufpoppt, in dem so etwas steht wie "Wie viele Zeilen sollen eingefügt werden?". Dann soll am besten mit der Maus aus einem Dropdown Menü 1-10 ausgewählt werden und mit OK bestätigen. Im Anschluss soll das Makro dann 1 bis 10 mal ausgeführt werden.

Es geht um folgendes Makro, das so ohne Probleme läuft.

       Sub NeueZeile()
         Dim Zl As Long, Sh As Object
       
         Zl = ActiveCell.Row
         ActiveCell.EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
         Cells(Zl, 27).Formula = "=SUM(" & Range("F" & Zl & ":X" & Zl).Address & ")"
         
         For Each Sh In ActiveWorkbook.Sheets
         
         With Sh
             If Sh.Cells(1, 1) = "Auswertung" Then
             .Cells(Zl + 8, 1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
             For Each Zelle In .Range(.Cells(Zl + 7, 1), .Cells(Zl + 7, .Columns.Count).End(xlToLeft))
               If Zelle.HasFormula Then
                   Zelle.Copy
                   Zelle.Offset(1, 0).PasteSpecial xlPasteFormulas
               End If
               Application.CutCopyMode = False
             Next
             End If
         End With
         
         Next
       End Sub

Besten Dank und Gruß,
Jelle

Betrifft: AW: Abfragebox per Makro von: 1713873.html
Geschrieben am: 19.09.2019 12:49:30

Servus Jelle,

mit ActiveCell zu arbeiten ist in meinen Augen immer etwas schwierig, aber teste mal:

   Sub NeueZeile()
     Dim Zl As Long, Sh As Object
     Dim Zelle As Range
     Dim i As Integer
     Dim a
   0:
     a = InputBox("Bitte Anzahl Leerzeilen eingeben (1-10):", "Zeilen einfügen")
     If Not IsNumeric(a) Then
       MsgBox "Bitte eine Zahl zwischen 1 und 10 eingeben!"
       GoTo 0:
     End If
     
     Zl = ActiveCell.Row
     For Each Sh In ActiveWorkbook.Sheets
       Sh.Activate
       For i = 1 To a
           With Sh
               If Sh.Cells(1, 1) = "Auswertung" Then
                   .Cells(Zl + 8, 1).EntireRow.Insert Shift:=xlDown, CopyOrigin:= _
   xlFormatFromLeftOrAbove
                   For Each Zelle In .Range(.Cells(Zl + 7, 1), .Cells(Zl + 7, .Columns.Count).End( _
   xlToLeft))
                     If Zelle.HasFormula Then
                         Zelle.Copy
                         Zelle.Offset(1, 0).PasteSpecial xlPasteFormulas
                     End If
                     Application.CutCopyMode = False
                   Next
               End If
           End With
       Next i
     Next
   End Sub
   

Grüße, Bernd

Betrifft: AW: Abfragebox per Makro von: 1713875.html
Geschrieben am: 19.09.2019 12:54:13

Hi

erforderlich:
1 x Userform1, 1 x Combobox1, 1 x Commandbutton1

Der nachfolgende Code führt dein bestehendes Makro (Call NeueZeile) x-fach gemäss Auswahl Combobox aus. Dein bestehendes Makro habe ich nicht geprüft oder hinterfragt.

Private Sub CommandButton1_Click()
  Dim i As Integer
  
  ' wenn keine Auswahl getroffen wurde, abbrechen
  If ComboBox1.ListIndex < 0 Then Exit Sub
  
  ' bestehendes Makro wird x-mal gemäss Combobox ausgeführt
  For i = 1 To ComboBox1.ListIndex + 1
      Call NeueZeile
  Next i
  
  ' userform schliessen
  Unload Me
  End Sub

Private Sub UserForm_Initialize()
  Dim i As Integer
  
  ' füllt die Combobox mit den Werten 1-10
  For i = 1 To 10
      ComboBox1.AddItem i
  Next i
  End Sub

cu
Chris

Betrifft: AW: Abfragebox per Makro von: 1713895.html
Geschrieben am: 19.09.2019 14:10:13

Hallo Chris,

das sieht professionell aus, nur bin ich dafür zu Limitiert. Wie und wo setze ich das ein, und wie erstelle ich die erforderlichen Userform, Combobox und Commandbutton?

Beste Grüße,
Jelle

Betrifft: AW: Abfragebox per Makro von: 1713912.html
Geschrieben am: 19.09.2019 14:39:37

Hi

Sorry, aber da müsstest du mal ein Youtube Video oder Tutorial anschauen.

cu
Chris

Betrifft: AW: Abfragebox per Makro von: 1713894.html
Geschrieben am: 19.09.2019 14:05:10

Hallo Bernd,

danke für die Antwort!
Das klappt fast so wie ich mir das vorgestellt habe, nur fehlt der obere Teil des Makros indem eine Zeile noch mit Formel im Aktiven Blatt eingefügt wird. Das soll dann dementsprechend auch X-mal gemacht werden. (ich hab den Teil mal fett gemacht)

Zusätzlich hätte ich gerne ein Dropdownmenü, wenn das irgendwie geht. Wenn nicht ist das so aber auch Ok.

Sub NeueZeile()
  Dim Zl As Long, Sh As Object

   
  Zl = ActiveCell.Row
  ActiveCell.EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
  Cells(Zl, 27).Formula = "=SUM(" & Range("F" & Zl & ":X" & Zl).Address & ")"
  
  For Each Sh In ActiveWorkbook.Sheets
  
  With Sh
      If Sh.Cells(1, 1) = "Auswertung" Then
      .Cells(Zl + 8, 1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
      For Each Zelle In .Range(.Cells(Zl + 7, 1), .Cells(Zl + 7, .Columns.Count).End(xlToLeft))
        If Zelle.HasFormula Then
            Zelle.Copy
            Zelle.Offset(1, 0).PasteSpecial xlPasteFormulas
        End If
        Application.CutCopyMode = False
      Next
      End If
  End With
  
  Next
End Sub

Gruß, Jelle

Betrifft: AW: Abfragebox per Makro von: 1713918.html
Geschrieben am: 19.09.2019 14:44:55

Da ich leider das Häkchen vergessen habe, dass dieser Beitrag noch nicht beantwortet ist noch mal die selbe Frage.


Hallo Bernd,

danke für die Antwort!
Das klappt fast so wie ich mir das vorgestellt habe, nur fehlt der obere Teil des Makros indem eine Zeile noch mit Formel im Aktiven Blatt eingefügt wird. Das soll dann dementsprechend auch X-mal gemacht werden. (ich hab den Teil mal fett gemacht)

Zusätzlich hätte ich gerne ein Dropdownmenü, wenn das irgendwie geht. Wenn nicht ist das so aber auch Ok.

Sub NeueZeile()
  Dim Zl As Long, Sh As Object

   
  Zl = ActiveCell.Row
  ActiveCell.EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
  Cells(Zl, 27).Formula = "=SUM(" & Range("F" & Zl & ":X" & Zl).Address & ")"
  
  For Each Sh In ActiveWorkbook.Sheets
  
  With Sh
      If Sh.Cells(1, 1) = "Auswertung" Then
      .Cells(Zl + 8, 1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
      For Each Zelle In .Range(.Cells(Zl + 7, 1), .Cells(Zl + 7, .Columns.Count).End(xlToLeft))
        If Zelle.HasFormula Then
            Zelle.Copy
            Zelle.Offset(1, 0).PasteSpecial xlPasteFormulas
        End If
        Application.CutCopyMode = False
      Next
      End If
  End With
  
  Next
End Sub

Gruß, Jelle

Betrifft: AW: Abfragebox per Makro von: 1713920.html
Geschrieben am: 19.09.2019 14:45:53

Da ich leider das Häkchen vergessen habe, dass dieser Beitrag noch nicht beantwortet ist noch mal die selbe Frage.


Hallo Bernd,

danke für die Antwort!
Das klappt fast so wie ich mir das vorgestellt habe, nur fehlt der obere Teil des Makros indem eine Zeile noch mit Formel im Aktiven Blatt eingefügt wird. Das soll dann dementsprechend auch X-mal gemacht werden. (ich hab den Teil mal fett gemacht)

Zusätzlich hätte ich gerne ein Dropdownmenü, wenn das irgendwie geht. Wenn nicht ist das so aber auch Ok.

Sub NeueZeile()
  Dim Zl As Long, Sh As Object

   
  Zl = ActiveCell.Row
  ActiveCell.EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
  Cells(Zl, 27).Formula = "=SUM(" & Range("F" & Zl & ":X" & Zl).Address & ")"
  
  For Each Sh In ActiveWorkbook.Sheets
  
  With Sh
      If Sh.Cells(1, 1) = "Auswertung" Then
      .Cells(Zl + 8, 1).EntireRow.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
      For Each Zelle In .Range(.Cells(Zl + 7, 1), .Cells(Zl + 7, .Columns.Count).End(xlToLeft))
        If Zelle.HasFormula Then
            Zelle.Copy
            Zelle.Offset(1, 0).PasteSpecial xlPasteFormulas
        End If
        Application.CutCopyMode = False
      Next
      End If
  End With
  
  Next
End Sub

Gruß, Jelle