Excel 需要VBA代码到图片填充形状的相对文件引用

使用Windows 7、Excel 2013 我对VBA非常陌生，花了几个小时尝试其他问题的不同解决方案

下面是我当前用于将数字签名插入用作表单的excel文档的代码

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

我的问题是： 当我与其他用户共享此工作簿时，代码工作正常。我们的文档文件夹中都有相同的文件“signature.jpg”，但这段代码只是指我的机器（msporney）。我需要文件位置的相对引用（C:\users\Anywhere）

我试过：

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

我总是会遇到同样的错误： 运行时错误“-2147024893（800700003）”：

---

对象“FillFormat”的方法“UserPicture”失败

如果您不必担心支持多种语言（它将始终是Windows的英语版本），您可以使用类似以下代码的内容（从）：

只需创建一个变量并将返回值

MyDocsPath

分配给它，然后连接文件夹位置的其余部分

如果您需要支持国际化（Windows的多语言版本），您将希望改用Windows API（此代码）：

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

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