Need VBA Code to a relative file reference for picture fill in shape

Question

Using Windows 7, Excel 2013 I'm very new to VBA and have spent hours trying different solutions from other questions.

Here is the code I am currently using to insert my digital signature into an excel document used as a form.

ActiveSheet.Shapes.AddShape(msoShapeRectangle, 208.3333070866, 659.1666929134, _
        243.3333858268, 38.3333070866).Select
    Selection.ShapeRange.ScaleWidth 1.0787668906, msoFalse, msoScaleFromTopLeft
    Selection.ShapeRange.ScaleHeight 1.0217405147, msoFalse, _
        msoScaleFromBottomRight
    Selection.ShapeRange.Line.Visible = msoFalse
    With Selection.ShapeRange.Fill
        .Visible = msoTrue
        .UserPicture "C:\Users\msporney\Documents\Signature.jpg"
        .TextureTile = msoFalse
        .RotateWithObject = msoTrue

My problem: The code works fine when I'm working I share this workbook with other users. We all have the same file "signature.jpg" in our documents folder, but this code is only referring to my machine (msporney). I need a relative reference to the file location (C:\users\anybody).

I've tried:

.UserPicture "C:\users\\Documents\Signature.jpg"
.UserPicture "C:\users\.\Documents\Signature.jpg"
.UserPicture "C:\users\\Documents\Signature.jpg"
.UserPicture "\..\Documents\Signature.jpg"

I always get the same error: Run-time error '-2147024893 (800700003)': Method "UserPicture' of object "FillFormat' failed

score 1 · Answer 1 · edited May 23 '17 at 11:49

If you don't have to worry about supporting multiple languages (it will always be an English-language version of Windows), you can use something like this code (from this SO question):

Public Function MyDocsPath() As String
    MyDocsPath = Environ$("USERPROFILE") & "\My Documents\"
End Function

Just create a variable and assign the return value of MyDocsPath to it, and then concatenate the rest of the folder location.

If you need to support internationalization (multiple language versions of Windows), you'll want to use the Windows API instead (code from this Office Dev Center article):

Public Declare Function SHGetSpecialFolderLocation _
    Lib "shell32" (ByVal hWnd As Long, _
    ByVal nFolder As Long, ppidl As Long) As Long

Public Declare Function SHGetPathFromIDList _
    Lib "shell32" Alias "SHGetPathFromIDListA" _
    (ByVal Pidl As Long, ByVal pszPath As String) As Long

Public Declare Sub CoTaskMemFree Lib "ole32" (ByVal pvoid As Long)

Public Const CSIDL_PERSONAL = &H5
Public Const CSIDL_DESKTOPDIRECTORY = &H10
Public Const MAX_PATH = 260
Public Const NOERROR = 0

Public Function SpecFolder(ByVal lngFolder As Long) As String
  Dim lngPidlFound As Long
  Dim lngFolderFound As Long
  Dim lngPidl As Long
  Dim strPath As String

  strPath = Space(MAX_PATH)
  lngPidlFound = SHGetSpecialFolderLocation(0, lngFolder, lngPidl)
  If lngPidlFound = NOERROR Then
    lngFolderFound = SHGetPathFromIDList(lngPidl, strPath)
    If lngFolderFound Then
        SpecFolder = Left$(strPath, _
            InStr(1, strPath, vbNullChar) - 1)
    End If
  End If
  CoTaskMemFree lngPidl
End Function

Need VBA Code to a relative file reference for picture fill in shape

1 Answers1