Office: Bilder einer Spalte anpassen

... schoenen guten Tag,

ich habe ein Problem mit Excel. Ich versuche Bilder lediglich einer Excelspalte "B" anzupassen, Ihre Größe ändern und die Position (mittig) zu erlangen.
Ich habe in der Spalte "G" andere Bilder, diese sollen nicht verändert werden.

Ich habe keine Erfahrungen oder Wissen von VBS. Ich habe bisher lediglich "gespielt" und getestet. Habe mit Codeschnipsel im Netz gesucht. Leider egal was ich versuche werden die Bilder in "G" mit "angesprochen".

Sub Bilder_ändern()
Dim Picture As Shape
For Each Picture In ActiveSheet.Shapes
With Picture
.Height = 85 'Tabellel.Range ("B") .Height
With Selection.ShapeRange(1)
.Name = "Generated_QR_CODES_" & Cell_Values.Address(False, False)
.Left = Cell_Values.Left + 2
.Top = Cell_Values.Top + 2
End With
Next
End Sub

Ich würde mich freuen, wenn jemand sich die Zeit nimmt mir zu helfen.
Die Bilder in "B" sollten eine Größe 85 haben. Die Bilder sollten zentriert werden und an die Zelle abhängig gemacht werden.

Danke für eure Hilfe und Mühen
Wolf

 

Hi,

dein Code wird so nicht funktionieren, da ein End With fehlt.

Wenn nur die Shapes in Spalte B bearbeitet werden sollen, dann musst du prüfen, wo sich das Bild befindet.

Code:

Sub Bilder_ändern()
Dim Picture As Shape
For Each Picture In ActiveSheet.Shapes
    With Picture
        If Picture.TopLeftCell.Column = 2 Then
            'hier dein Code
        End If
    End With
Next
End Sub

 

Hi Wolf,

was meinst du mit "Größe 85"?

Hier ein Code, der die Shapes, die auf Spalte B liegen, so anpasst, dass sie in der Höhe der Zellhöhe entsprechen und zentriert auf der Zelle liegen:

Code:

Sub Bilder_ändern()
    Dim Picture As Shape
    For Each Picture In ActiveSheet.Shapes
        With Picture
            If .TopLeftCell.Column = 2 Then
                .Height = .TopLeftCell.Height '<== Höhe
                .Name = "Generated_QR_CODES_" & .TopLeftCell.Address(False, False)
                .Left = .TopLeftCell.Left + Columns(2).Width / 2 - .Width / 2 '<== Position links
                .Top = .TopLeftCell.Top '<== Position oben
            End If
        End With
    Next
End Sub

---

 

Hallo,

danke, die zwei Scripts funktionieren gut. Mit "Größe 85" meinte ich dies ".Height = 85 'Tabellel.Range ("B") .Height"

Zentriert in der Zelle wäre allerdings besser, einige der Bilder haben einen "weißen Rand" rechts und links andere nicht.

Die Bilder wurden in die Excelspalten reinkopiert und haben so keinen eigenen Ordner. Wo Excel dies hinterlegt, weiß ich nicht.

Kann man mit einem VBS-Script die Bilder auch mit den Zellen "verheiraten", ich muss nach der Anpassung die Daten sortieren.

Danke euch für eure Mühen und Zeit
Wolf

 

Zentriert sind die Bilder schon, mit eurem Code ich hatte einen Kopierfehler beim ersten Test. Vielen lieben Dank!

Besteht die Möglichkeit, mit VBS, die Bilder auch mit den Zellen zu "verheiraten", sodass die Bilder beim Verschieben oder Kopieren der Zelle diese mitkopiert werden? Ich muss nach der Anpassung die Daten sortieren. Per Hand ist dies etwas viel ich habe 811 Zeilen.

Noch eine letzte Frage bitte, wie würde der Code lauten, wenn ich nur in "B" alle Bilder markieren moechte.

Dies Beispiel funktioniert leider nicht:
Option Explicit
Sub Bilder_in_Zwischenablage()
Dim Picture As Shape
For Each Picture In ActiveSheet.Shapes
Picture.Select Replace:=False
Next
Selection.B
End Sub

Vielen Dank für eure nette Hilfe
Wolf

 

habe versucht die code zu "anzupassen um diese in B zu markieren. Dies funktioniert leider soauch nicht:

Sub Bilder_ändern()
Dim Picture As Shape
For Each Picture In ActiveSheet.Shapes
With Picture
If Picture.TopLeftCell.Column = 2 Then
ActiveSheet.ChartObjects.Select
End If
End With
Next
End Sub

 

Alles Shapes, die auf Spalte B liegen kann man wie folgt selektieren:

Code:

Sub ShapesSelektieren()
    Dim arrShapes()
    Dim lngZaehler As Long
    Dim shaShape As Shape
    lngZaehler = 1
    For Each shaShape In ActiveSheet.Shapes
        If shaShape.TopLeftCell.Column = 2 Then
            ReDim Preserve arrShapes(1 To lngZaehler)
            arrShapes(lngZaehler) = shaShape.Name
            lngZaehler = lngZaehler + 1
        End If
    Next shaShape
    ActiveSheet.Shapes.Range(arrShapes).Select
End Sub

---

 

Vielen lieben Dank, du hast mir sehr geholfen.

Ich Wünsche dir noch einen schönen Tag
Wolf

 

upp's

ich habe die Bilder mit deinem Code in spalte B gelöscht. Nachdem ich die kopiert habe, von einer Backup-Tabelle und wieder reinkopiert habe, sind etliche der Bilder nicht in der korrekten Tabelle/Spalte. Ein paar Bilder, nicht alle werden wie bei einem Kartenspiel mehrfach vervielfältigt. Was mache ich falsch?

Danke
Wolf

 

Weshalb einige Bilder nicht in der richtigen Spalte sind, kann ich dir nicht sagen, weil ich nicht neben dir gesessen habe als du sie eingefügt hast.
Was das mehrfache Vervielfältigen von Shapes betrifft, so passiert das in Excel immer wieder. Dagegen hilft meistens nur, nach dem Löschen der Shapes die Mape erstmal zu speichern und zu schließen.

---

 

Villen Dank, ich versuche es noch einmal.
Du hast mir bereits mindestens 10 Stunden Arbeit erspart heute, deine Tipp's sind sehr gut.
Wolf