ソースワークシートへのアクセス権がある場合、ユーザーフォームのコンボボックスが表示されます。

Question

コンボボックス付きのユーザーフォームがあります。このコンボボックスは別のブックからのリストで埋められます。

私のuserformを使用する必要のあるユーザーには、コンボボックスソースブックを開く権限がありません。

私がしたいことは、正しい権利を持つ誰かがuserformを使用するたびにコンボボックスを更新するようにコードを再構築することです。

誰かが権利を持っていない場合は、コンボボックスのアップをスキップして、最後に更新されたバージョンで作業する必要があります。

これは私の必要性を満たすためにどのように変更する必要があるか、私のコードです。

Dim ListItems As Variant, i As Integer 
Dim SourceWB As Workbook 
    With Me.cmbOperators 
    .Clear ' remove existing entries from the listbox 
    ' turn screen updating off, 
    ' prevent the user from seeing the source workbook being opened 
    Application.ScreenUpdating = False 
    ' open the source workbook as ReadOnly 
    Set SourceWB = Workbooks.Open("path", _ 
     False, True) 
    ListItems = SourceWB.Worksheets(1).Range("B2:B121").Value 
    ' get the values you want 
    SourceWB.Close False ' close the source workbook without saving changes 
    Set SourceWB = Nothing 
    ListItems = Application.WorksheetFunction.Transpose(ListItems) 
    ' convert values to a vertical array 
    For i = 1 To UBound(ListItems) 
     .AddItem ListItems(i) ' populate the listbox 
    Next i 
    .ListIndex = -1 ' no items selected, set to 0 to select the first item 
    Application.ScreenUpdating = True 
End With 

私はこのファイルには権利がありませんので、今すぐテストできません。次のことができますか？最後に始まり

On error goto errorhandler 

で

errorhandler: 
check=0 
resume next 

私の変更されたコード：

Dim ListItems As Variant, i As Integer 
Dim SourceWB As Workbook 
With Me.cmbOperators 
check = 1 
    '.Clear ' remove existing entries from the listbox 
    ' turn screen updating off, 
    ' prevent the user from seeing the source workbook being opened 
    Application.ScreenUpdating = False 
    ' open the source workbook as ReadOnly 
    Set SourceWB = Workbooks.Open("\\rsdfp1\mteam\Bestanden SVs\Employees overview\Masterfile Employees Production.xlsx", _ 
     False, True) 
    If check = 1 Then .Clear 
    ListItems = SourceWB.Worksheets(1).Range("B2:B121").Value 
    ' get the values you want 
    SourceWB.Close False ' close the source workbook without saving changes 
    Set SourceWB = Nothing 
    ListItems = Application.WorksheetFunction.Transpose(ListItems) 
    ' convert values to a vertical array 
    For i = 1 To UBound(ListItems) 
     .AddItem ListItems(i) ' populate the listbox 
    Next i 
    .ListIndex = -1 ' no items selected, set to 0 to select the first item 
    Application.ScreenUpdating = True 
End With 

Answer 1

は、この場合のエラー処理のために、簡単なOn Error Resume Next使用し、その後、SourceWBが開かれているかどうかをテストすることができます。それはあなたの元のコードに存在していたよう

Dim ListItems As Variant, i As Integer 
Dim SourceWB As Workbook 
    With Me.cmbOperators 
     ' turn screen updating off, 
     ' prevent the user from seeing the source workbook being opened 
     Application.ScreenUpdating = False 
     ' open the source workbook as ReadOnly 
     On Error Resume Next 
     Set SourceWB = Workbooks.Open("path", _ 
             False, True) 
     On Error GoTo 0 
     If Not SourceWB Is Nothing Then 
      .Clear ' remove existing entries from the listbox 
      ListItems = SourceWB.Worksheets(1).Range("B2:B121").Value 
      ' get the values you want 
      SourceWB.Close False ' close the source workbook without saving changes 
      Set SourceWB = Nothing 
      ListItems = Application.WorksheetFunction.Transpose(ListItems) 
      ' convert values to a vertical array 
      For i = 1 To UBound(ListItems) 
       .AddItem ListItems(i) ' populate the listbox 
      Next i 
     End If 
     .ListIndex = -1 ' no items selected, set to 0 to select the first item 
     Application.ScreenUpdating = True 
    End With 

しかし、これは、リストでユーザーを残します - それは、誰かが成功したソースファイルにアクセスした最後の時間だったので、それはは、リストを与えることはありません。

Answer 2

ここでは、あなたのケースでエラー処理を使用する方法である：

私はそれだけではわからないファイルにアクセスするための十分な権限がないというエラーコードは75です。しかし、簡単に変更できます！ ;）

Sub test_Mick17() 


    Dim ListItems As Variant, i As Integer 
    Dim SourceWB As Workbook 
    With Me.cmbOperators 

     '.Clear ' remove existing entries from the listbox 
     ' turn screen updating off, 
     ' prevent the user from seeing the source workbook being opened 
     Application.ScreenUpdating = False 



    On Error GoTo ErrorHandler 
     ' open the source workbook as ReadOnly 
     Set SourceWB = Workbooks.Open("\\rsdfp1\mteam\Bestanden SVs\Employees overview\Masterfile Employees Production.xlsx", _ 
     False, True) 
     If Check = 1 Then .Clear 
     ListItems = SourceWB.Worksheets(1).Range("B2:B121").value 
     ' get the values you want 
     SourceWB.Close False ' close the source workbook without saving changes 
     Set SourceWB = Nothing 
     ListItems = Application.WorksheetFunction.Transpose(ListItems) 
     ' convert values to a vertical array 
     For i = 1 To UBound(ListItems) 
     .AddItem ListItems(i) ' populate the listbox 
     Next i 


NoRigths: 
     .ListIndex = -1 ' no items selected, set to 0 to select the first item 
     Application.ScreenUpdating = True 
    End With 


    Exit Sub 
ErrorHandler: 
    If Err.Number <> 75 Then 
     MsgBox "Error " & Err.Number & vbCrLf & _ 
       Err.Description, vbCritical + vbOKOnly 
     Exit Sub 
    Else 
     Resume NoRigths 
    End If 

    End Sub