Am urmatorul cod atasat unui CommandButton.
Codul as vrea sa aduca:
- in coloana A incepand cu A11 --> Application.UserName (celulele A1:A10 sunt ocupate)
- in coloana B incepand cu B11 --> adresa de email a userului (celulele B1:B10 sunt ocupate)
Codul nu trebuie sa multiplice informatiile, adica daca un user si o adresa de email exista in lista, codul nu trebuie sa le mai scrie odata.
Codul nu functioneaza si nu ii dau de cap. Rog ajutor.
Multumesc
Cod: Selectaţi tot
Dim OL, olAllUsers, oExchUser, oentry, myitem As Object
Dim User As String
Dim EmptyRow
If Me.OptionButton1 = Unchecked _
And Me.OptionButton2 = Unchecked Then
MsgBox "Nicio optiune exprimata." & vbCrLf & "Alegeti Da sau Nu.", vbOKOnly, "Informatie necesara"
End If
If Me.OptionButton2.Value = True Then
Application.DisplayAlerts = False
ThisWorkbook.Close SaveChanges:=False
ElseIf Me.OptionButton1.Value = True Then
Worksheets("Revizuire").Activate
ActiveSheet.Unprotect ""
Set OL = CreateObject("outlook.application")
Set olAllUsers = OL.Session.AddressLists.Item("All Users").AddressEntries
User = OL.Session.CurrentUser.Name
Set oentry = olAllUsers.Item(User)
Set oExchUser = oentry.GetExchangeUser()
For Each Cell In Range("A11:A1000")
If Cell.Value = Application.UserName Then
Exit Sub
Else
EmptyRow = WorksheetFunction.CountA(Range("A:A")) + 1
Cells(EmptyRow, 1).Select
Selection.Value = Application.UserName
End If
Next Cell
For Each Cell In Range("B11:B1000")
If Cell.Value = oExchUser.PrimarySmtpAddress Then
Exit Sub
Else
EmptyRow = WorksheetFunction.CountA(Range("B:B")) + 1
Cells(EmptyRow, 1).Select
Selection.Value = oExchUser.PrimarySmtpAddress
End If
Next Cell
ActiveSheet.Protect ""
ThisWorkbook.Save
ThisWorkbook.Close
End If
End Sub