Bilder per Knopfdruck anpassen

Moderator: ModerationP

Bilder per Knopfdruck anpassen

Beitragvon balzmatthias » 24. Okt 2021, 09:50

Hallo zusammen.

Ich benutzt zur Zeit folgenden Code, um die Bilder auf eine größe zu bekommen:

Sub Bilder_ändern()
Dim Picture As Shape
For Each Picture In ActiveSheet.Shapes
If Picture.Type = 13 Then Picture.Height = 180
Next
End Sub

Jetzt möchte ich gerne das er nur die Bilder ändert die ich auch markiert habe.
Desweiteren sollen die an eine bestimmte Stelle im Sheet, wie kann ich das machen???

DANKE
balzmatthias
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 10
Registriert: 06. Sep 2009, 14:37

Re: Bilder per Knopfdruck anpassen

Beitragvon Flotter Feger » 24. Okt 2021, 13:33

Hallo,

um einen Basis-Code aufzuzeichnen, wirf den Makro-Rekorder an und passe anschließend den Code an deine Notwendigkeiten an.

Mehr geben deine bisherigen Ausführungen leider nicht her.
VG Sabina

Wer auch weiter Hilfe erwartet, sollte sich nicht zu schade sein, ein kurzes Feedback zu geben.
Bei mir läuft Win 7 32-Bit - Office 2016 Pro Plus 32-Bit, Office 2019 Pro Plus 32-Bit und Office 2021 Pro Plus 32-Bit
Benutzeravatar
Flotter Feger
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 3327
Registriert: 24. Okt 2016, 16:40

Re: Bilder per Knopfdruck anpassen

Beitragvon hddiesel » 24. Okt 2021, 14:37

Hallo Matthias,

versuche es einmal so, wirkt sich auf den markierten Tabellenbereich (Selection) aus.
Liegt die linke obere Ecke des Picture in diesem Bereich, dann wird die Größe geändert.
Code: Alles auswählen
Sub Bilder_ändern()
    Dim Picture As Shape
    For Each Picture In ActiveSheet.Shapes
        If Not Application.Intersect(Selection, Picture.TopLeftCell) Is Nothing Then
            If Picture.Type = 13 Then Picture.Height = 180
        End If
    Next
End Sub

Um die Bilder zu verschieben, fehlen weitere Infos.
Schau Dir auch einmal (Hochladen von Dateien) und an deinen Beitrag anhängen an.
viewtopic.php?f=166&t=680200
Zuletzt geändert von hddiesel am 24. Okt 2021, 15:00, insgesamt 1-mal geändert.
Mit freundlichen Grüssen
Karl


BS: Windows 10_64-Bit, MS Office Professional Plus 2016_32-Bit, incl. Microsoft Visual Basic for Applications 7.1
Benutzeravatar
hddiesel
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 4259
Registriert: 17. Feb 2006, 11:40
Wohnort: Deutschland

Re: Bilder per Knopfdruck anpassen

Beitragvon Kuwe » 24. Okt 2021, 14:48

Hallo Matthias,

so in der Art sollte es gehen. Musst halt die Zellbereiche entsprechend ändern.

Code: Alles auswählen
Sub bbb()
  Dim objPicture As Object
  Dim oSel As Object
  Set oSel = Selection
  If VarType(oSel) = 9 Then
    For Each objPicture In oSel.ShapeRange
      With objPicture
        .Width = 100
        .Top = Range("keineAhnung").Top
        .Left = Range("keineAhnung").Left
      End With
    Next objPicture
  End If
End Sub
Gruß Uwe
Benutzeravatar
Kuwe
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 6669
Registriert: 30. Dez 2003, 18:37

Re: Bilder per Knopfdruck anpassen

Beitragvon balzmatthias » 24. Okt 2021, 15:27

Danke Uwe

So wollte ich es haben.

Besteht die möglichkeit es nicht direkt an den Rand der Zelle zu setzen sondern A2 + 3 pixel

Verstehst was ich meine.

DANKE
balzmatthias
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 10
Registriert: 06. Sep 2009, 14:37

Re: Bilder per Knopfdruck anpassen

Beitragvon Kuwe » 24. Okt 2021, 15:39

Hallo Matthias,

Code: Alles auswählen
        .Top = Range("A2").Top + 3
        .Left = Range("A2").Left + 3
Gruß Uwe
Benutzeravatar
Kuwe
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 6669
Registriert: 30. Dez 2003, 18:37

Re: Bilder per Knopfdruck anpassen

Beitragvon hddiesel » 24. Okt 2021, 16:03

Hallo Matthias,

wurde das Bild mit der linken oberen Bildecke, grob in eine Zelle geschoben,
wird das Bild in dieser Zelle, mit der linken oberen Bildecke, mit dem Plus oder Minuswert ausgerichtet und in der Bildhöhe angepasst.
Dann ersparst du dir die Rangangabe für das Bild.
Code: Alles auswählen
Sub Bilder_in_der_TopLeftCell_anpassen()
    Dim objPicture As Object
    Dim oSel As Object
    Set oSel = Selection
    If VarType(oSel) = 9 Then
        For Each objPicture In oSel.ShapeRange
            With objPicture
                .Width = 100
                .Top = objPicture.TopLeftCell.Top + 3
                .Left = objPicture.TopLeftCell.Left + 3
            End With
        Next objPicture
    End If
End Sub
Mit freundlichen Grüssen
Karl


BS: Windows 10_64-Bit, MS Office Professional Plus 2016_32-Bit, incl. Microsoft Visual Basic for Applications 7.1
Benutzeravatar
hddiesel
Im Profil kannst Du frei den Rang ändern
 
Beiträge: 4259
Registriert: 17. Feb 2006, 11:40
Wohnort: Deutschland


Zurück zu Excel Forum (provisorisch)

Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 31 Gäste