@Rainer

Hallo Rainer,
hatte ganz vergessen das Makro einzustellen :-)))
Für Verbesserungsvorschläge immer offen /
Gruß Sonnenpeter
PS: VBA gut ist übertrieben / mit Recorder ist auch falsch :-)))
Option Explicit


Sub Bild_in_der_Mitte_des_Bildschimes_Positionieren()
Dim Bildbreite, Bildhöhe
Dim SichtbarerBildschirm As String
Dim Pos1, Pos2 As String
Dim P1Left, P1Top, P2Left, P2Top
Dim B_PosTop, B_PosLeft
If ActiveSheet.Pictures.Count = 0 Then
MsgBox "Kein Bild gefunden"
Exit Sub
End If
Bildbreite = ActiveSheet.Shapes("Bild 1").Width
Bildhöhe = ActiveSheet.Shapes("Bild 1").Height
SichtbarerBildschirm = Windows(1).VisibleRange.Address
Pos2 = Right(SichtbarerBildschirm, Len(SichtbarerBildschirm) _
- InStr(1, SichtbarerBildschirm, ":"))
Pos1 = Left(SichtbarerBildschirm, InStr(1, SichtbarerBildschirm, ":") - 1)
With Range(Pos1)
P1Top = .Top
P1Left = .Left
End With
With Range(Pos2)
P2Top = .Top
P2Left = .Left
End With
B_PosTop = (P1Top + P2Top) / 2
B_PosLeft = (P1Left + P2Left) / 2
ActiveSheet.Shapes("Bild 1").Top = B_PosTop - Bildhöhe / 2
ActiveSheet.Shapes("Bild 1").Left = B_PosLeft - Bildbreite / 2
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: @Rainer

03.01.2005 21:06:42

Josef

Hallo Sepp............

03.01.2005 22:18:05

Sonnenpeter

AW: Hallo Sepp............

03.01.2005 22:34:32

Josef

Danke Sepp! o.T.

03.01.2005 22:41:53

Sonnenpeter

Sub Bild_in_der_Mitte_des_Bildschimes_Positionieren() Dim BildBreite As Double, BildHoehe As Double, _ SichtbareBreite As Double, SichtbareHoehe As Double, _ A1_Breite As Double, A1_Hoehe As Double Dim rng As Range If ActiveSheet.Pictures.Count = 0 Then MsgBox "Kein Bild gefunden" Exit Sub End If Set rng = Windows(1).VisibleRange.Range("A1") BildBreite = ActiveSheet.Shapes("Bild 1").Width BildHoehe = ActiveSheet.Shapes("Bild 1").Height SichtbareBreite = Windows(1).VisibleRange.Width SichtbareHoehe = Windows(1).VisibleRange.Height A1_Breite = rng.Left - (rng.Width / 2) A1_Hoehe = rng.Top - (rng.Height / 2) With ActiveSheet.Shapes("Bild 1") .Left = (SichtbareBreite / 2) - (BildBreite / 2) + A1_Breite .Top = (SichtbareHoehe / 2) - (BildHoehe / 2) + A1_Hoehe End With End Sub

Hallo Sepp,
ich habe 10 Std. an meinem Makro gebastelt.
Hatte vorher kräftig die Recherche und das WWW abgefragt aber keinen Ansatz gefunden.
Rainer machte dann den Vorschlag mit der Bildschirmauflösung. Aus meinerSicht ein Irrweg, da Excel die Zelle A1 mit Top 0 und mit Left 0 ausweist.
Das ausprobieren mit der Bildschirmauflösung hat mich einiges an Zeit gekostet und war dann für mich nicht machbar. Deshalb bin ich dann den Weg über Windows(1).VisibleRange.Address gegangen.
Es funktionierte, freu.....
Na ja, Excel ist mein Hobby ;-))) Bin richtig froh diese Seite und euch Excelexperten gefunden zu haben. Speziel Du hast mir schon einige mal bei meinem sogenannten Hobby geholfen.
Gruß / Sonnenpeter
PS: Dein Vorschlag funktioniert nicht so ganz / wenn die Spalten unterschiedlich breit sind, ist das Bild leider nicht mehr in der Mitte. Trotzdem Danke für Deine Hilfestellung.

Sub Bild_in_der_Mitte_des_Bildschimes_Positionieren() Dim BildBreite As Double, BildHoehe As Double, _ SichtbareBreite As Double, SichtbareHoehe As Double Dim rng As Range If ActiveSheet.Pictures.Count = 0 Then MsgBox "Kein Bild gefunden" Exit Sub End If Set rng = Windows(1).VisibleRange.Range("A1") BildBreite = ActiveSheet.Shapes("Bild 1").Width BildHoehe = ActiveSheet.Shapes("Bild 1").Height SichtbareBreite = Windows(1).VisibleRange.Width SichtbareHoehe = Windows(1).VisibleRange.Height With ActiveSheet.Shapes("Bild 1") .Left = rng.Left + (SichtbareBreite - BildBreite) / 2 .Top = rng.Top + (SichtbareHoehe - BildHoehe) / 2 End With End Sub

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread