Question

使用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 \ anybody）。

我试过了：

.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”失败

Answer 1

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

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

只需创建一个变量并为其分配MyDocsPath的返回值，然后连接文件夹位置的其余部分。

如果您需要支持国际化（Windows的多语言版本），您将需要使用Windows API（来自此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

需要VBA代码到图片填充形状的相对文件参考

1 个答案: