Slet/skjul række samt billede hvis værdi er <1

Måske kan denne makro bruges

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C3:C17")) Is Nothing Then
Dim xRg As Range
Dim xPic As Picture
'Slet billede
If Target < 1 Then
Set xRg = Target.EntireRow
    For Each xPic In ActiveSheet.Pictures
        Set xPicRg = Range(xPic.TopLeftCell.Address & ":" & xPic.BottomRightCell.Address)
        If Not Intersect(xRg, xPicRg) Is Nothing Then xPic.Delete
    Next
Target.EntireRow.Hidden = True
End If
End If
End Sub

Hej,

Jeg er meget ny til at bruge VBA. Har prøvet og sætte det ind, men synes ikke der sker noget. Gør jeg noget forkert? :)

- Peter

Måske er det et spørgsmål om hvor du har indsat makroen. Højreklik på fanebladet, vælg Vis Koder og indsæt den der

Må jeg skrive til din mail eller et andet sted :)
Så kan jeg nemlig sende et billede af hvor jeg har sat det ind.

- Peter

VBA´en ser ikke ud til at virke.... Betyder det noget hvor billederne er? Billederne befinder sig parallelt med kolonne som har jeg skrevet ovenfor. Altså det vil sige, at billederne befinder sig i A3 og ned til A17? :)

Det er det sidste jeg mangler for at den er færdig.

Håber I kan hjælpe :)

- Peter

Skriv til kober(snabel-a)mail.dk

Med denne makro skulle det virke:

Sub MovePicture()
Dim xRg, xPicRg As Range
Dim xPic As Picture
On Error Resume Next
Worksheets("Ark2").Select
Set xRg = Worksheets("Ark2").Range("A2:B18")
    For Each xPic In ActiveSheet.Pictures
        Set xPicRg = Range(xPic.TopLeftCell.Address & ":" & xPic.BottomRightCell.Address)
        If Not Intersect(xRg, xPicRg) Is Nothing Then xPic.Delete
    Next
Worksheets("Ark1").Select
For x = 3 To 17
Worksheets("Ark2").Rows(x).Hidden = False
If Worksheets("Ark1").Cells(x, 7) < 1 Then
Worksheets("Ark2").Rows(x).Hidden = True
Else
Worksheets("Ark1").Range("A" & x).CopyPicture
Worksheets("Ark2").Range("A" & x).PasteSpecial
End If
Next
Worksheets("Ark2").Select
End Sub