xlf | xlfAddLogoToBanner


0. Add a logo image to the worksheet


Add the xlf logo image to a worksheet (figure 1), similar to the logo on this web page.


  1. xlf-blue-banner
    Fig 1: the xlf logo image applied to a worksheet

1. xlfAddLogoToBanner - the VBA code


In this example, the picture image file is located on a web server. Code 1 uses the mso AddPicture method. The image location (Left, and Top) and size (Width, and Height) is measured in points, where 1 point is equal to 1/72 of an inch.

1.1 AddPicture method (embedding)


Code 1 uses the Shapes object AddPicture method available in the Excel object model. Code 1a has the arguments by position, and Code 1b has arguments by name. The syntax is described below the code window.



Code 1a: Sub procedure xlfAddLogoToBanner add xlf logo to a selected area of worksheet
ActiveSheet.Shapes.AddPicture - arguments by position
Private Sub xlfAddLogoToBanner()
Dim imgSource As String

    imgSource = "https://excelatfinance.com/online/wp-content/uploads/2015/06/xlf.png"
    ActiveSheet.Shapes.AddPicture imgSource, msoFalse, msoTrue, 13, 13, 35, 35

End Sub

Code 1b: Sub procedure xlfAddLogoToBanner add xlf logo to a selected area of worksheet
ActiveSheet.Shapes.AddPicture - arguments by name
Private Sub xlfAddLogoToBanner()
    ActiveSheet.Shapes.AddPicture Filename:="https://excelatfinance.com/online/wp-content/uploads/2015/06/xlf.png", _
                                  LinkToFile:=False, _
                                  SaveWithDocument:=True, _
                                  Left:=13, Top:=13, _
                                  Width:=35, Height:=35
End Sub

Syntax

There are two variations of the AddPicture method, AddPicture and AddPicture2.

  1. 1. AddPicture method - creates a picture from an existing file (local or remote / web). Returns a Shape object that represents the new picture.

    expression.AddPicture(Filename, LinkToFile, SaveWithDocument, Left, Top, Width, Height)

AddPicture
argument / parameter
details - type - description
Filenamerequiredstring - the source of the picture file
LinkToFilerequiredMsoTriState [msoTrue / msoFalse] - make an independent copy of the file
Described as TriState but only two of five tri-state values are supported. msoFalse with value 0, and msoTrue with value -1. Therefore msoTriState is described as a Boolean value
SaveWithDocument requiredMsoTriState [msoTrue / msoFalse] - save the picture with the workbook
Leftrequiredsingle - distance from left of worksheet to the left of the picture in points
Toprequiredsingle - distance from top of worksheet to the top of the picture in points
Widthrequiredsingle - the width of the picture in points
Heightrequiredsingle - the height of the picture in points


Syntax

  1. 2. AddPicture2 method - creates a picture from an existing file (local or remote / web). Returns a Shape object that represents the new picture. This version includes an image compression argument, number 8 by position. The degree of compression depends on the original file type.

    expression.AddPicture2(Filename, LinkToFile, SaveWithDocument, Left, Top, Width, Height, Compress)

AddPicture2
argument / parameter
details - type - description
Compress #8requiredMsoPictureCompress - specifies whether the picture is compressed when inserted.
Enumerations details:
msoPictureCompressDocDefault value -1,
msoPictureCompressFalse value 0, and
msoPictureCompressTrue value 1


The compress parameter


An experiment was constructed with a 4,356 KB bmp file comprising mostly white space. The resultant xls file sizes were:

  1. Compress: msoPictureCompressTrue; file size 59 KB
  2. Compress: msoPictureCompressFalse; file size 59 KB
    [Experimental platform: Microsoft Office 365 ProPlus Version 1812 (Build 11126.20196)]

xlf tip the AddPicture = SaveWithDocument parameter allows the image to be embedded in the Workbook.


 

1.2 Insert method - macro recorder (linking)


Using the Macro Recorder with the WS Insert > Illustration > Pictures sequence, produces the macro shown in code 2a. The Shapes object Insert method is available in the Excel object model. image (paste the full URL to the Insert Picture, File name field),



Code 2a: Sub procedure Macro1 from the macro recorder to add image and then reshape
ActiveSheet.Pictures.Insert
Sub Macro1()
'
' Macro1 Macro
'
    ActiveSheet.Pictures.Insert( _
        "https://excelatfinance.com/online/wp-content/uploads/2015/06/xlf.png").Select
    Selection.ShapeRange.ScaleWidth 0.4101992656, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 0.4101993843, msoFalse, msoScaleFromTopLeft
    Range("C10").Select
End Sub

About Code 2a

  1. Line 16: Selection.ShapeRange property returns a ShapeRange object
    ShapeRange.ScaleWidth method has syntax:
    expression.ScaleWidth(Factor, RelativeToOriginalSize,Scale)
    Scale the width of the shape by a scaling factor
  2. ScaleWidth
    argument / parameter
    details - type - description
    Factorrequiredsingle - the ratio of the width after resizing to the current or original width
    RelativeToOriginalSizerequiredMsoTriState [msoTrue / msoFalse] - make an independent copy of the file
    Described as TriState but only two of five tri-state values are supported. msoFalse with value 0, and msoTrue with value -1
    Scale optional msoScaleFrom in an enumeration value which specifies the part of the shape that retains its position
    Enumerations details:
    msoScaleFromBottomRight value 2
    msoScaleFromMiddle value 1
    msoScaleFromTopLeft value 0

  3. Another version of the code is detailed in code 2b, this time using the Picture object. This allows the more conventional position properties of Left, Top, Width and Height


Code 2b: Sub procedure xlfAddLogoToBanner2 add xlf logo to a selected area of worksheet
ActiveSheet.Pictures.Insert
Sub xlfAddLogoToBanner2()
Dim img As Picture

    Set img = ActiveSheet.Pictures.Insert("https://excelatfinance.com/online/wp-content/uploads/2015/06/xlf.png")
    With img
        .Left = 50 + 13
        .Top = 13
        .Width = 35
        .Height = 35
    End With

End Sub

xlf alert Beware! :: link - the Pictures.Insert method will only create a link to the image. The image will only display a place holder if linked to a local drive and the workbook is opened on a different computer.

2. Shape object properties exploration


This code sample (code 3) is based on objects in the Shapes collection, where each item is addressed by its index number (Shapes(i)).



Code 3: Sub procedure ShapePropertiesV1 - selected Shape Properties
Sub ShapeProperties_v1()
Dim shp As Shapes
Dim i As Integer
Set shp = ActiveSheet.Shapes

    For i = 1 To shp.Count
        Debug.Print "ID: " & shp(i).ID
        Debug.Print "Name: " & shp(i).Name
        Debug.Print "Type: " & shp(i).Type & " [11: msoLinkedPicture; 13: msoPicture]"
        Debug.Print "TopLeftCell: " & shp(i).TopLeftCell
        Debug.Print "BottomRightCell: " & shp(i).BottomRightCell
        Debug.Print vbNewLine
    Next i

End Sub

Details of the MsoShapeType enumeration are listed in MsoShapeType


3. Code modules


Module1



Code 4: Module1
Option Explicit
Const BannerRng As String = "A1:N3"
Const BannerRowHeight As Integer = 20


' ===========================
' Contents:
' 1. xlfAddBlueBanner
' 2. xlfLogoExists
' 3. xlfAddLogoToBanner
' 4. xlfDeleteLogosInBanner
' ===========================

' ===========================
' 1. xlfAddBlueBanner
Private Sub xlfAddBlueBanner()
' Source: https://excelatfinance.com/xlf/xlf-add-blue-banner.php
    Range(BannerRng).Select
    With Selection
        .Interior.Color = RGB(55, 95, 145)   ' xlf blue banner fill colour
        .RowHeight = BannerRowHeight
    End With
    Selection.Resize(1, 1).Select
    ' Debug.Print "RGB(55, 95, 145) -> PatternColorIndex value: " & Selection.Interior.PatternColorIndex   ' returns -4105
End Sub

' ===========================
' 2. xlfLogoExists
Private Function xlfLogoExists(Rng As Range) As Boolean
Dim Shp As Shape
    For Each Shp In Rng.Parent.Shapes
        ' this code checks for any shape
        ' is not restricted to msoPicture ot msoLinkedPicture
        If Not Intersect(Rng, Shp.TopLeftCell) Is Nothing Then
            xlfLogoExists = True
            Exit For
        End If
    Next Shp
End Function

Private Sub TestxlfLogoExists()
Dim Ans As Boolean
    Ans = xlfLogoExists(Range(BannerRng))
End Sub

' ===========================
' 3. xlfAddLogoToBanner
Private Sub xlfAddLogoToBanner()
' AddPicture method
    ActiveSheet.Shapes.AddPicture Filename:="https://excelatfinance.com/online/wp-content/uploads/2015/06/xlf.png", _
                                  LinkToFile:=False, _
                                  SaveWithDocument:=True, _
                                  Left:=13, Top:=13, _
                                  Width:=35, Height:=35
End Sub

' ===========================
' 4. xlfDeleteLogosInBanner
Private Sub xlfDeleteLogosInBanner()
Dim Cont As Boolean     ' continue
Dim Shp As Shape
Dim Indx As Integer
    Cont = xlfLogoExists(Range(BannerRng))
    If Cont = True Then
        For Each Shp In ActiveSheet.Shapes
            If Shp.Type = msoLinkedPicture Or Shp.Type = msoPicture Then
                Shp.Delete
            End If
        Next Shp
    End If
End Sub


Module2



Code 5: Module2
Option Explicit

' ===========================
Sub Macro1()
'
' Macro1 Macro
'

'
    ActiveSheet.Pictures.Insert( _
        "https://excelatfinance.com/online/wp-content/uploads/2015/06/xlf.png").Select
    Selection.ShapeRange.ScaleWidth 0.4101992656, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 0.4101993843, msoFalse, msoScaleFromTopLeft
    Range("C10").Select
End Sub

' ===========================
Sub NewImg()
Dim img As Picture

    Set img = ActiveSheet.Pictures.Insert("https://excelatfinance.com/online/wp-content/uploads/2015/06/xlf.png")
    With img
        .Left = 50 + 13
        .Top = 13
        .Width = 35
        .Height = 35
    End With

End Sub

' ===========================
Sub NewImg2()
Dim pic As Picture
Dim Shp As Shape

    Set pic = ActiveSheet.Pictures.Insert("https://excelatfinance.com/online/wp-content/uploads/2015/06/xlf.png")

    With pic.ShapeRange
        .LockAspectRatio = msoTrue
        .Left = 250 + 13
        .Top = 13
        .Width = 35
    End With
    pic.Select
    Set Shp = Selection

End Sub

' ===========================
Sub ShapePropertiesV1()
Dim Shp As Shapes
Dim i As Integer
Set Shp = ActiveSheet.Shapes

    For i = 1 To Shp.Count
        Debug.Print "ID: " & Shp(i).ID
        Debug.Print "Name: " & Shp(i).Name
        Debug.Print "Type: " & Shp(i).Type & " [11: msoLinkedPicture; 13: msoPicture]"
        Debug.Print "TopLeftCell: " & Shp(i).TopLeftCell
        Debug.Print "BottomRightCell: " & Shp(i).BottomRightCell
        Debug.Print vbNewLine
    Next i

End Sub

Sheet1



Code 6: Sheet1
Option Explicit

' ===========================
Private Sub cmdAddLogo_Click()
    Application.Run "Module1.xlfAddLogoToBanner"
End Sub

' ===========================
Private Sub cmdDeleteLogo_Click()
    Application.Run "Module1.xlfDeleteLogosInBanner"
End Sub


References