Sub Formula_Example() Range("b4").Formula = "=b2+b3" End Sub Sub Effacer_B4() If MsgBox("Etes-vous certain de vouloir supprimer le contenu de B4 ?", vbYesNo, "Demande de confirmation") = vbYes Then Range("B4").ClearContents MsgBox "Le contenu de B4 a été effacé !" End If End Sub Sub GetCell() Dim userName As String 'userName = InputBox("Enter username") userName = Range("a15").Value MsgBox "user : " & userName End Sub Sub GetUser() Dim userName As String Dim objConnection, objCommand, objRecordSet Dim strFName, strLName userName = Range("a15").Value Set RootDSE = GetObject("LDAP://RootDSE") searchRoot = RootDSE.Get("defaultNamingContext") Set objConnection = CreateObject("ADODB.Connection") Set objCommand = CreateObject("ADODB.Command") Set objRecordSet = CreateObject("ADODB.Recordset") objConnection.Provider = "ADsDSOObject" objConnection.Open "Active Directory Provider" Set objCommand.ActiveConnection = objConnection strQueryText = ";(&(objectCategory=Person)(samAccountName=" & userName & "));" & "givenName,sn,displayName" objCommand.CommandText = strQueryText objCommand.Properties("Page Size") = 15 objCommand.Properties("Timeout") = 25 objCommand.Properties("Cache Results") = False Set objRecordSet = objCommand.Execute objRecordSet.MoveFirst strFName = objRecordSet.Fields("givenName").Value strLName = objRecordSet.Fields("sn").Value MsgBox strFName & " " & strLName End Sub Sub SendMail() With CreateObject("CDO.Message") .From = "tony.montana@dbs.fr" .To = "baptiste.conio@dbs.fr" .Subject = "test" .TextBody = "test" .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.dbs.fr" .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 .Configuration.Fields.Update On Error Resume Next .Send End With End Sub Option Explicit Private Sub ListOnMsxBox() Dim I As Long Dim Lastrow As Long Dim intCounter As Integer Dim strMyList As String Lastrow = Sheets("Blad1").Cells(Rows.Count, "A").End(xlUp).Row For I = Lastrow To 1 Step -1 If Sheets("Blad1").Cells(I, 2).Value = TextBox1.Value And Sheets("Blad1").Cells(I, 4) > "" Then intCounter = intCounter + 1 If intCounter <= 10 Then If strMyList = "" Then strMyList = Sheets("Blad1").Cells(I, 1).Value & ", " & Sheets("Blad1").Cells(I, 3).Value Else strMyList = strMyList & vbNewLine & Sheets("Blad1").Cells(I, 1).Value & ", " & Sheets("Blad1").Cells(I, 3).Value End If Else Exit For End If End If Next I MsgBox "Last " & intCounter & " item(s) used by " & TextBox1.Value & vbNewLine & "is: " & strMyList End Sub