Invoegen afbeelding zonder range

[Danielle22]

Hallo allemaal,

Ik gebruik sinds kort deze macro:

Sub AfbeeldingLUSGroep1()
Sheets("Test").Select
 Dim N As Object, ws As Worksheet, l As Double, T As Double
  Set ws = ActiveWorkbook.Worksheets("Test")
   For Each cl In ws.Range([B]"J1:J2780"[/B]).SpecialCells(2) 'zoek de afbeeldingen in de range
     If Right(cl, 4) = ".jpg" Then
 With cl.Offset(, 7): l = .Left: T = .Top: End With 'ofset waarde is naar welke kolom
   Set N = ws.Pictures.Insert(cl.Value)
 With N: .Left = l: .Top = T: End With
   End If
  Next cl
End Sub

Deze code kijkt in de range J1:J2780 waar er een link staat naar een afbeelding en zet deze afbeelding in kolom Q op dezelfde regel van waar de link staat. Dit werkt goed alleen worden er regelmatig regels verwijderd of toegevoegd en dan moet steeds de range aangepast worden (een gehele kolom als range gebruiken is helaas niet mogelijk).

Is het ook mogelijk om de code zo te maken dat wanneer in kolom H een 1 staat dat dan de afbeelding wordt toegevoegd, zodat ik geen range meer hoef te gebruiken?

Alvast heel erg bedankt voor de eventuele reacties.

Groetjes,

Danielle

 

[wampier]

Je kunt dan de gehele gebruikte J range gebruiken en via

if cl.offset(0,-2).value = 1 then

kijken of er een 1 staat. Indien er een distinctief eind is aan de lijst in kolom J kun je ook eerst kijken hoever in kolom J gezocht moet worden zonder een hulpkolom te gebruiken. (een distinctief einde kan zijn: een of meerdere lege regels, een woord, etc.)

 

[spaarie]

Ja dat kan wel

For Each cl In columns(10).specialcells(2)
   If right(cl, 4) = ".jpg" and cl.offset(, -2).value = 1 then 'zoek de afbeeldingen in de range

 

[Danielle22]

Heel erg bedankt!

Het werkt perfect :thumb:.

Groetjes,

Danielle

 

[Danielle22]

Hallo,

Ik gebruik ook een macro om afbeeldingen te verwijderen. Dat is deze code:

Sub Verwijderpicgroep2()
Sheets("Test").Select 'het verwijderen van de plaatjes uit productgroep 1
Dim sh As Shape, r As Range
For Each sh In ActiveSheet.Shapes
Set r = Application.Intersect(Range(sh.TopLeftCell, sh.BottomRightCell), [a2781:ae3723])
If Not r Is Nothing Then sh.Delete
Next
End Sub

Wat moet ik veranderen om alleen de afbeeldingen te verwijderen als er in kolom J een 1tje staat? Net als ij het invoegen van de afbeeldingen.

Alvast heel erg bedankt voor de eventuele reacties.

Groetjes,

Danielle

 

[Danielle22]

Ah het is gelukt.



Groetjes,

Danielle