Sub und und Privat Sub kombinieren
23.04.2016 16:24:21
Jürgen
Kann ich eigentlich Sub Codes in Privat Sub miteinbauen?
Mir gehts um folgendes hab einen Code mit dem ich Daten aktualisieren und Bildereinfügen lasse.
Nun muss ich den gleichen code in ein paar checkboxen mit dranhängen zecks kombinieren.
Wenn ich aber dann an dem Code mal was ändern muss dann muss ich das bei allen machen deshalb wollte ich mir einen Master code anlegen und diesen dann aufrufen lassen.
Nur habe ich keine Ahnung wie das gehen soll.
Das ist der Code der ein paar mal eingebaut werden muss
Private Sub CommandButton1_Click() 'Kantenbild Aktualisieren
Application.ScreenUpdating = False 'Bildschirm Aktivität ausschalten
If MsgBox("Es werden alle Händisch geänderten Daten gelöscht wollen sie das?", vbYesNo Or _
vbQuestion, "Abfrage") = vbYes Then
Range("A21:CE21").AutoFill Destination:=Range("A21:CE500"), Type:=xlFillDefault '------ _
Formeln aktualisieren
Range("G22").Select
End If
'--------------------------------Kantenbilder aktualisieren
Dim Pfad As String, Wiederholungen As Long
On Error Resume Next 'bei Fehler zur nächsten Zeile
Const cSpalte = 23 ' Spalte W Bilder löschen
Dim sh As Shape
For Each sh In ActiveSheet.Shapes
If sh.TopLeftCell.Column = cSpalte Then sh.Delete
Next sh
Pfad = Sheets("Material").Cells(1, 17) 'Pfad der Bilder Zeile/Spalte
For Wiederholungen = 22 To Range("X600").End(xlUp).Row 'Suchspalte 22=Zeile
Cells(Wiederholungen, 23).Activate 'Einfügepunkt der Bilder
ActiveSheet.Pictures.Insert(Pfad & Cells(Wiederholungen, 24) & ".png").Select 'Wiederholungen, _
24= X Spalte Namen
Next
Range("g21").Select
Application.ScreenUpdating = True 'Bildschirm Aktivität einschalten
End Sub
Das sind die Checkboxen wo der obere Code mit eingebaut/verlinkt gehört
Private Sub CheckBox1_Click() 'zeilen ausblenden Holzliste
If AutoFilterMode Then
If CheckBox1.Value Then
ActiveSheet.Range("$AD$1:$AG$500").AutoFilter Field:=1, Criteria1:="nein"
Else
ActiveSheet.Range("$AD$1:$AG$500").AutoFilter Field:=1, Criteria1:="=ja", _
Operator:=xlOr, Criteria2:="=nein"
End If
End If
End Sub
Jürgen