Supportnet Computer
Planet of Tech

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

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