PDA

Vollständige Version anzeigen : Bild in den Vordergrund


Celia
21.11.2008, 11:23
Hallo,

ich habe folgendes Makro:

Sub Anzeige()
Worksheets("Zuschlag GJ").Range("A1:G23").CopyPicture _
Appearance:=xlScreen, Format:=xlBitmap
With Worksheets("Beistellungen")
.Paste Destination:=.Range("a1")
End With
Application.Wait Now + TimeSerial(0, 0, 5)
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Delete
End Sub


dass mit einen bestimmten Tabellenbereich eines anderen Blattes für 5 Sekunden anzeigt. Leider ist diese Anzeige zum Teil verdeckt wenn ich einige Zeilen gefiltert habe...bzw. wenn ich die Kopfzeile fixiert habe.
Kann man diese Bitmap auch in den Vordergrund holen ??

Gruß
Celia

Peter9
21.11.2008, 16:40
Hallo Celia,

Probiere es mit dem hier mal



Sub Anzeige()
Dim na
Worksheets("Zuschlag GJ").Range("A1:G23").CopyPicture _
Appearance:=xlScreen, Format:=xlBitmap
With Worksheets("Beistellungen")
.Paste Destination:=.Range("a1")
'name des entstandenen Bildes ermitteln
na = ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Visible
'neuen namen geben
ActiveSheet.Shapes(na).Name = "Testbild"

'Active Picture in den hintergrund holen mit "False"
ActiveSheet.Shapes("Testbild").Visible = False

End With
'Active Picture in den vordergrund holen mit "True"
ActiveSheet.Shapes("Testbild").Visible = True

Application.Wait Now + TimeSerial(0, 0, 5)
'ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Delete
ActiveSheet.Shapes("Testbild").Delete
End Sub

Gruss Peter9

Celia
24.11.2008, 09:11
Hallo Peter,

sorry, dass ich mich erst jetzt melde ! War am Freitagmittag nicht mehr in der Firma...

Erstmal vielen Dank für das Makro !
Es hängt leider an der dieser Stelle

ActiveSheet.Shapes(na).Name = "Testbild"

Fehlermeldung: der Index in der angegebenen Sammlung ist ausserhalb des zulässigen Bereichs.
Also das Bild ist im Vordergrund, aber dann geht es nicht mehr weiter..

Gruß
Celia

Celia
24.11.2008, 09:17
Hallo Peter,
ich habe das mit dem Namen wieder rausgeschmissen. Jetzt klappt es !

Sub Anzeige()
Dim na
Worksheets("Zuschlag GJ").Range("A1:G23").CopyPicture _
Appearance:=xlScreen, Format:=xlBitmap
With Worksheets("Beistellungen")
.Paste Destination:=.Range("a1")
na = ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Visible
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Visible = False

End With
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Visible = True
Application.Wait Now + TimeSerial(0, 0, 5)
ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Delete

End Sub

Vielen Dank !!!!

Gruß
Celia