0

我正在尝试将 Excel 配置文件中的当前用户与特定工作表上的名称列表相匹配。鉴于在运行功能时是特定用户，他/她的照片应该插入到特定的单元格中。我已经做了以下事情：

Sub Input_by()

Dim myPassword As String
Dim fPath As String
Dim tDate As String
myPassword = "trade2013"
Sheets("Collection Slip").Unprotect Password:=myPassword

If Environ$("UserName") = "LeonQi" Then
    Sheets("Collection Slip").Select
    Range("B29").Select
    With Sheets("Collection Slip").Pictures.Insert _
        ("G:\ITS\Shared\Signature\Leon Qiao.jpg")
         .Top = Range("B31").Top
         .Left = Range("B31").Left
         .Width = 250
         .Height = 58
    End With
    Sheets("Collection Cover Sheet").Select
    Range("G31").Select
    ActiveCell.FormulaR1C1 = Environ$("UserName")
    Sheets("Collection Slip").Select
    Range("B29").Select
    ActiveCell.FormulaR1C1 = "Leon Qiao"
    Sheets("Collection Cover Sheet").Select

ElseIf Environ$("UserName") = "RoisinK" Then
    Sheets("Collection Slip").Select
    Range("B29").Select
    With Sheets("Collection Slip").Pictures.Insert _
        ("G:\ITS\Shared\Signature\Roisin Kehoe.jpg")
        .Top = Range("B31").Top
        .Left = Range("B31").Left
        .Width = 250
        .Height = 58
    End With
    Sheets("Collection Cover Sheet").Select
    Range("G31").Select
    ActiveCell.FormulaR1C1 = Environ$("UserName")
    Sheets("Collection Slip").Select
    Range("B29").Select
    ActiveCell.FormulaR1C1 = "Roisin Kehoe"
    Sheets("Collection Cover Sheet").Select

ElseIf Environ$("UserName") = "LiamT" Then
    Sheets("Collection Slip").Select
    Range("B29").Select
    With Sheets("Collection Slip").Pictures.Insert _
        ("G:\ITS\Shared\Signature\Liam Tressler.jpg")
        .Top = Range("B31").Top
        .Left = Range("B31").Left
        .Width = 250
        .Height = 58
    End With
    Sheets("Collection Cover Sheet").Select
    Range("G31").Select
    ActiveCell.FormulaR1C1 = Environ$("UserName")
    Sheets("Collection Slip").Select
    Range("B29").Select
    ActiveCell.FormulaR1C1 = "Liam Tressler"
    Sheets("Collection Cover Sheet").Select

End If

Sheets("Collection Slip").Protect Password:=myPassword

End Sub

但是我意识到它不是非常用户友好，一个不具备 VBA 能力的人不会知道如何通过编码更新列表。因此，我只是想知道是否无论如何我可以获得一个贯穿所有现有名称列表的代码（在名为“用户管理”的工作表中的 A 列上）并将其与当前的 Excel 用户匹配。如果当前用户是 = 建立在列表上，则插入他/她的图片，否则我们存在子。

谢谢你的帮助

莱昂

4

1 回答 1

0

如果我了解您要执行的操作，则以下内容可能对您有用。假设您要检查的用户名列表在“用户管理”表中的 A1:A100 范围内。并且假设在同一张表中，在单元格 B1:B100 中，是用于命名jpg图片文件的全名列表。

Sub AddPix()

    Dim userNames() As String
    Dim userPixNames() As String
    Dim currentUser AS String

    With Worksheets("User Management")       
        'Assign the user names to an array (much faster than looping through range)
        userNames = .Range("A1:A100")
        userPixNames = .Range("B1:B100")
    End With
    For i = 1 To 100
        'The 1 in userNames(i,1) is needed because of the way
            'VBA creates an array assigned directly from a range
            '(as we did above)
        If Environ$("UserName") = userNames(i, 1) Then
            'Have I missed where the picture will be inserted?
            With Sheets("Collection Slip").Pictures.Insert _
                ("G:\ITS\Shared\Signature\" & userPixNames(i, 1) & ".jpg")
                .Top = Range("B31").Top
                .Left = Range("B31").Left
                .Width = 250   
                .Height = 58
            End With
            'short-circuit the For loop when current user's name is found               
            i = 100
        End If
     Next i
End Sub

附带说明一下，您可以避免代码中的大多数（如果不是全部）选择（这很好，因为选择很慢）。例如，

Sheets("Collection Cover Sheet").Select
Range("G31").Select
ActiveCell.FormulaR1C1 = Environ$("UserName")

通常会写成类似

Dim wsCover as Worksheet
Set wsCover as Worksheets("Collection Cover Sheet") 

wsCover.Range("G31").Value = Environ$("UserName")

将工作表分配给具有较短名称的工作表对象只是为了使代码更易于阅读。也没有性能受到影响。

于 2013-08-12T06:04:07.473 回答