Ændre billedstørrelse fra makro

Måske kan dette bruges:

Sub Picture()
Dim Pic As Shape
For Each Pic In Worksheets("Sheet1").Shapes
Pic.LockAspectRatio = msoTrue
Pic.Width = 50
Next
End Sub

Ovenstående var i punkter. Hvis du vil have det i mm skal 3. sidste linje ændres til

Pic.Width = 50 / 25.4 * 72

Som altid når Jens laver noget, så virker det :) Dog kan jeg ikke få den til at tage et enkelt markeret område - den tager hele regnearket, men det gør ikke så meget :)

Så prøv med denne makro, som retter alle billeder der (delvist) ligger indenfor et valgt område (her valgt som A1R30)

Sub ModifyPic()
    Dim PicRng As Range
    Dim Pic As Picture
    Dim Rng As Range
    Application.ScreenUpdating = False
    Set Rng = Range("A1:R30")
    For Each Pic In ActiveSheet.Pictures
        Set PicRng = Range(Pic.TopLeftCell.Address & ":" & Pic.BottomRightCell.Address)
        If Not Intersect(Rng, PicRng) Is Nothing Then
        Pic.Width = 50 / 25.4 * 72
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Hej Jens48
Jeg bruger din kode fra denne tråd og den fungerer upåklagelig. En ting jeg ikke kan regne ud er hvilke tal jeg skal ændre for at billede bliver større eller mindre har prøvet, det ændrer selvfølgelig billede størrelsen, når jeg ændrer tallene. Men selve sammen hænget kan jeg ikke se.
Jeg syntes jeg har set en kode fra dig til at få billede til at passe i cellen, også hvis man ændrer cellens højde og brede, kan det have sin rigtighed?
Kan du evt. være behjælpelig.
Klaus W

Hej Klaus,

Er det ikke forklaret i #2?
Du skal bruge
Pic.LockAspectRatio = msoTrue
for at sikre at forholdet mellem højde og bredde ikke ændres, og med formelen i #2 sættes bredden (i eksemplet til 50 mm)