plaatje verplaatsen.

[popipipo]

Ik ben aan het experimenteren met VBA

Ik wil een plaatje uit cel D2 verwijderen
Daarna wil ik een plaatje uit B2 halen en in D2 plaatsen.
Beide cellen hebben een verschillende achtergrondkleur.
Deze mag niet veranderen.

Via macro opnemen heb ik het gedaan dan gaat het goed, maar als ik de macro via een knop laat lopen gaat het niet goed.
Hij kan de plaatjes niet goed selecteren.
Het gaat mij dus om het plaatje in de cel
Dit kan elke keer een ander plaatje zijn.
Dus zoeken op naam van het plaatje werkt niet.

Onderstaande macro gebruik ik.

Sub kopie()

'doelcel legen
    Range("d2").Activate
    Selection.Cut
    
'broncel kopieëren
    Range("b2").Activate
          Selection.Cut
      
 'doelcel plakken
    Range("d2").Activate
    ActiveSheet.Paste

End Sub

 

[hazesoft]

Moet dit niet gewijzigd worden?

'broncel kopieëren
Range("b2").Activate
Selection.Copy

 

[popipipo]

Moet dit niet gewijzigd worden?

Nee, want ik wil het plaatje verplaatsen en niet kopieëren
Bovendien had ik dat ook al geprobeerd.

 

[WHER]

Willem,

Probeer de bijlage eens.

 

[popipipo]

Dit werkt inderdaad perfect!!

Zelfs als er in de begin situatie geen plaatje in doelcel staat.
Dat was ik nl nog vergeten te vermelden.

Maar heb je een verklaring voor waarom het opnemen van een macro niet goed werkt in deze situatie?

 

[WHER]

Neen, daar heb ik geen verklaring voor. Ik heb de aanpak via Intersect ook ook maar "gegoogeld".

 

[popipipo]

Bedankt voor de moeite.

 

[popipipo]

De vraag even geheropend.

Ben in de afrondende fase van mijn bestandje.
Ben nu bezig met layout.

Het plaatje wordt dus keurig verplaatst naar andere cel
Echter hij komt linksboven in de cel te staan.
Kan deze ook nog gecentreerd in de cel komen te staan.

...
shp.TopLeftCell
...

heb dit veranderd in

...
shp.CenterCell
...

Dit werkt echter niet.

 

[WHER]

Macro aangepast.

 

[popipipo]

Hij deed het nog niet helemaal goed.
Doordat de macro eerst de shape delete was hij de afmetingen van het plaatje weer kwijt .
Daarom het iets later gedefinieerd

Hier de nieuwe:

Sub tst()
Dim shp As Shape, i As Long, j As Long, k As Long, l As Long, m As Long, n As Long
i = Range("D4").Left
j = Range("D4").Top
k = Range("D4").Width
l = Range("D4").Height

For Each shp In ActiveSheet.Shapes
If Not Intersect(Range("D4"), shp.TopLeftCell) Is Nothing And _
Not Intersect(Range("D4"), shp.BottomRightCell) Is Nothing Then
[COLOR="red"]shp.Delete[/COLOR]
End If
Next shp
For Each shp In ActiveSheet.Shapes
If Not Intersect(Range("B4"), shp.TopLeftCell) Is Nothing And _
Not Intersect(Range("B4"), shp.BottomRightCell) Is Nothing Then

With shp
[COLOR="seagreen"]m = shp.Width
n = shp.Height
[/COLOR]
.Left = i + (k - m) / 2
.Top = j + (l - n) / 2
End With
End If

Next shp

End Sub

Bedankt nogmaals