0

使用 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”失败

4

1 回答 1

1

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

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

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

如果您需要支持国际化（Windows 的多语言版本），则需要改用 Windows API（代码来自此Office 开发中心文章）：

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
于 2013-09-05T01:09:00.060 回答