How Can I Quickly Add My Logo to the Top Corner of All My Worksheets?

We must update the header logos of our reports to reflect the latest corporate rebranding!

Sure! But doing it manually for 50+ worksheets spread across 5+ workbooks is not exactly a quick update…

Nor does it fall under the value-adding category to justify the time spent on manual effort.

 

There is a quick and painless way to do it with VBA, though!

 

 

Sub logo()
Dim Wks As Worksheet
Dim Sh As Shape
Dim x As Integer
Dim y As Integer
Dim Cell As Range
'******************************************
'written by Angelina Teneva, 2013
'******************************************
For Each Wks In ActiveWorkbook.Worksheets
If Wks.Visible = True Then Wks.Activate
If ActiveSheet.Shapes.Count > 0 Then 'replaces previous logo
'the code assumes that the only picture in the respective tab is the previous logo
'and there are no other pictures that should remain there)
For Each Sh In ActiveSheet.Shapes
If Sh.Type = msoPicture Then Sh.Delete 'removes previous logo
Next Sh
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Set Cell = ActiveSheet.Range("B2")
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Cell.Select 'makes sure the logo is always inserted in the same cell
ActiveSheet.Pictures.Insert ("C:\Users\hp\Desktop\logo.png")
For Each Sh In ActiveSheet.Shapes 'centers picture in cell
If Sh.TopLeftCell.Address(0, 0) = "B2" Then
Sh.Height = 33
Sh.width = 79
Sh.Top = 10
End If
Next Sh
Else
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'adds a new brand logo
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Set Cell = ActiveSheet.Range("B2")
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Cell.Select
ActiveSheet.Pictures.Insert ("C:\Users\hp\Desktop\logo.png")
For Each Sh In ActiveSheet.Shapes
If Sh.TopLeftCell.Address(0, 0) = "B2" Then
Sh.LockAspectRatio = msoTrue 'locks width-to-height ration
Sh.Height = 33
Sh.width = 79
Sh.Top = 10
End If
Next Sh
End If
Next Wks
End Sub

But how do you know that these are the dimensions you should use for the new logo?

I don’t. I manually resized the logo to the size I wanted and then checked the dimensions by using the following code

Sub ShowShapeDimensions()
Dim l As Long
Dim t As Long
Dim h As Long
Dim w As Long
Dim Sh As Shape
'----------------------------------------------
For Each Sh In ActiveSheet.Shapes
If Sh.TopLeftCell.Address(0, 0) = "B2" Then
l = Sh.Left
t = Sh.Top
h = Sh.Height
w = Sh.width
End If
Next Sh
'Return Dimensions
ActiveSheet.Range("A1") = "Left: " & l
ActiveSheet.Range("A2") = "Top: " & t
ActiveSheet.Range("A3") = "Height: " & h
ActiveSheet.Range("A4") = "Width: " & w
End Sub

Happy VBA coding!

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google photo

You are commenting using your Google account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s

This site uses Akismet to reduce spam. Learn how your comment data is processed.