Supportnet / Forum / Tabellenkalkulation
Frage f. VBA-Experten - Steuerelement einfügen
Frage
Hallo,
wer könnte mir den folgenden VBA-Code umstellen???
Dieser Code sucht nach einem bestimmten Wert in meiner Tabelle und fügt im Anschluss daran eine neue Zeile ein. Danach werden noch bestimme Zellen der Zeile "runtergezogen" bzw. in die neue Zeile reinkopiert. Alles Super bis dahin!
Jetzt möchte ich aber erreichen, dass mir zusätzlich eine Checkbox eingefügt wird, die in der jeweiligen neuen Zeile in der Spalte G sitzt und mit dieser Zelle verbunden ist.
Also zb.:
Mein Suchkriterium befindet sich in D30.
jetzt wird eine neue Zeile (31) eingefügt und bestimmte Werte aus Zeile 30 in Zeile 31 übernommen. Jetzt möchte in G31 eine checkbox die auch mit G31 verbunden ist dazu eingefügt bekommen. Wird nochmal eine Zeile eingefügt selbes Spiel für Zeile 32...usw.
Kann man sowas überhaupt machen? Weiß jemand Rat? Vielen Dank Euch!
Der Code lautet:
Sub Einfügenxyz()
´Einfügen Zeile xyz
Dim zeile As Long
Dim zl As Long
Dim rng As Range
Application.ScreenUpdating = False
ActiveSheet.Select
´Eintrag mit "xyz" finden
zl = Range("D:D").Find(What:="xyz").Row
´von hier zum Ende der Liste springen
If Cells(zl + 1, 4) <> "" Then
zeile = Cells(zl, 4).End(xlDown).Row
Else
zeile = zl
End If
´neue Zeile einfügen
Rows(zeile + 1).Insert
´Spalten "B:J" von oben auffüllen
Set rng = Range(Cells(zeile, 2), Cells(zeile, 11))
rng.AutoFill Range(rng, rng.Offset(1, 0))
´Spalten "F" löschen
Range("F" & zeile + 1).ClearContents
Application.ScreenUpdating = True
End Sub
Antwort 1 von Mola
Hallo,
okay einfügen habe ich jetzt hinbekommen....jetzt bleibt offen wie ich das Baby mit der gewünschten Zeile verlinke....ma schauen - bei Erfolg poste ich ma das Makro hier rein...
Grüße
Mola
okay einfügen habe ich jetzt hinbekommen....jetzt bleibt offen wie ich das Baby mit der gewünschten Zeile verlinke....ma schauen - bei Erfolg poste ich ma das Makro hier rein...
Grüße
Mola
Antwort 2 von Mola
okay....erledigt...würde so aussehen:
jetzt noch ein bissle feinschliff....
Grüße
Mola
Sub Einfügenxyz()
´Einfügen xyz
Dim zeile As Long
Dim zl As Long
Dim rng As Range
Dim objCheckBox As Object
Application.ScreenUpdating = False
ActiveSheet.Select
´Eintrag mit "xyz" finden
zl = Range("D:D").Find(What:="xyz").Row
´von hier zum Ende der Liste springen
If Cells(zl + 1, 4) <> "" Then
zeile = Cells(zl, 4).End(xlDown).Row
Else
zeile = zl
End If
´neue Zeile einfügen
Rows(zeile + 1).Insert
´Spalten "B:J" von oben auffüllen
Set rng = Range(Cells(zeile, 2), Cells(zeile, 11))
rng.AutoFill Range(rng, rng.Offset(1, 0))
´Spalten "F" löschen
Range("F" & zeile + 1).ClearContents
With Range("G" & zeile + 1)
Set objCheckBox = ActiveSheet.CheckBoxes.Add( _
Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
End With
With objCheckBox
.LinkedCell = "G" & zeile + 1
jetzt noch ein bissle feinschliff....
Grüße
Mola
Sub Einfügenxyz()
´Einfügen xyz
Dim zeile As Long
Dim zl As Long
Dim rng As Range
Dim objCheckBox As Object
Application.ScreenUpdating = False
ActiveSheet.Select
´Eintrag mit "xyz" finden
zl = Range("D:D").Find(What:="xyz").Row
´von hier zum Ende der Liste springen
If Cells(zl + 1, 4) <> "" Then
zeile = Cells(zl, 4).End(xlDown).Row
Else
zeile = zl
End If
´neue Zeile einfügen
Rows(zeile + 1).Insert
´Spalten "B:J" von oben auffüllen
Set rng = Range(Cells(zeile, 2), Cells(zeile, 11))
rng.AutoFill Range(rng, rng.Offset(1, 0))
´Spalten "F" löschen
Range("F" & zeile + 1).ClearContents
With Range("G" & zeile + 1)
Set objCheckBox = ActiveSheet.CheckBoxes.Add( _
Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
End With
With objCheckBox
.LinkedCell = "G" & zeile + 1