Pictures centers!

Cliparts in one worksheet, or in all worksheets are centered vertically and horizontal in the cell. The pictures can be aligned also again left above. The individual examples differed only in the kind, how the worksheet is addressed. The files at the end of the article are Excelfiles of the version 2003 and 2007.


The following code belonged In "Module1"

Option Explicit
Public Sub Picture_Center_Index()
Dim shpPicture As Shape
With ThisWorkbook.Worksheets(1)
For Each shpPicture In .Shapes
If shpPicture.Type = msoPicture Then
shpPicture.Left = shpPicture.Left + _
(shpPicture.TopLeftCell.Width - _
shpPicture.Width) / 2
shpPicture.Top = shpPicture.Top + _
(shpPicture.TopLeftCell.Height - _
shpPicture.Height) / 2
End If
Next shpPicture
End With
End Sub
Public Sub Picture_Center_Name()
Dim shpPicture As Shape
With ThisWorkbook.Worksheets("Sheet1")
For Each shpPicture In .Shapes
If shpPicture.Type = msoPicture Then
shpPicture.Left = shpPicture.Left + _
(shpPicture.TopLeftCell.Width - _
shpPicture.Width) / 2
shpPicture.Top = shpPicture.Top + _
(shpPicture.TopLeftCell.Height - _
shpPicture.Height) / 2
End If
Next shpPicture
End With
End Sub
Public Sub Picture_Center_CodeName()
Dim shpPicture As Shape
With Sheet1
For Each shpPicture In .Shapes
If shpPicture.Type = msoPicture Then
shpPicture.Left = shpPicture.Left + _
(shpPicture.TopLeftCell.Width - _
shpPicture.Width) / 2
shpPicture.Top = shpPicture.Top + _
(shpPicture.TopLeftCell.Height - _
shpPicture.Height) / 2
End If
Next shpPicture
End With
End Sub
Public Sub Picture_Center_All_Worksheet()
Dim wksSheet As Worksheet
Dim shpPicture As Shape
For Each wksSheet In ThisWorkbook.Worksheets
With wksSheet
For Each shpPicture In .Shapes
If shpPicture.Type = msoPicture Then
shpPicture.Left = shpPicture.Left + _
(shpPicture.TopLeftCell.Width - _
shpPicture.Width) / 2
shpPicture.Top = shpPicture.Top + _
(shpPicture.TopLeftCell.Height - _
shpPicture.Height) / 2
End If
Next shpPicture
End With
Next wksSheet
End Sub
Public Sub Picture_Reset()
Dim wksSheet As Worksheet
Dim shpPicture As Shape
For Each wksSheet In ThisWorkbook.Worksheets
With wksSheet
For Each shpPicture In .Shapes
If shpPicture.Type = msoPicture Then
shpPicture.Left = _
shpPicture.TopLeftCell.Left
shpPicture.Top = _
shpPicture.TopLeftCell.Top
End If
Next shpPicture
End With
Next wksSheet
End Sub


Sample 2003

Sample 2007

Kommentare

Beliebte Posts aus diesem Blog

Formeln - auch Array - per VBA eintragen...

Alle Dateien eines Ordners - Optional mit Unterordner

Excel -> Word in Textmarken (Bookmarks)...