Advertisement
Combreal

Exemple.vba

Jan 28th, 2021 (edited)
1,860
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Sub Formula_Example()
  2.     Range("b4").Formula = "=b2+b3"
  3.  
  4. End Sub
  5.  
  6. Sub Effacer_B4()
  7.     If MsgBox("Etes-vous certain de vouloir supprimer le contenu de B4 ?", vbYesNo, "Demande de confirmation") = vbYes Then
  8.         Range("B4").ClearContents
  9.         MsgBox "Le contenu de B4 a été effacé !"
  10.     End If
  11. End Sub
  12.  
  13. Sub GetCell()
  14.     Dim userName As String
  15.    
  16.     'userName = InputBox("Enter username")
  17.    userName = Range("a15").Value
  18.     MsgBox "user : " & userName
  19. End Sub
  20.  
  21. Sub GetUser()
  22.     Dim userName As String
  23.     Dim objConnection, objCommand, objRecordSet
  24.     Dim strFName, strLName
  25.    
  26.     userName = Range("a15").Value
  27.     Set RootDSE = GetObject("LDAP://RootDSE")
  28.     searchRoot = RootDSE.Get("defaultNamingContext")
  29.     Set objConnection = CreateObject("ADODB.Connection")
  30.     Set objCommand = CreateObject("ADODB.Command")
  31.     Set objRecordSet = CreateObject("ADODB.Recordset")
  32.     objConnection.Provider = "ADsDSOObject"
  33.     objConnection.Open "Active Directory Provider"
  34.     Set objCommand.ActiveConnection = objConnection
  35.     strQueryText = "<LDAP://" & searchRoot & ">;(&(objectCategory=Person)(samAccountName=" & userName & "));" & "givenName,sn,displayName"
  36.     objCommand.CommandText = strQueryText
  37.     objCommand.Properties("Page Size") = 15
  38.     objCommand.Properties("Timeout") = 25
  39.     objCommand.Properties("Cache Results") = False
  40.     Set objRecordSet = objCommand.Execute
  41.     objRecordSet.MoveFirst
  42.    
  43.     strFName = objRecordSet.Fields("givenName").Value
  44.     strLName = objRecordSet.Fields("sn").Value
  45.     MsgBox strFName & " " & strLName
  46. End Sub
  47.  
  48. Sub SendMail()
  49.     With CreateObject("CDO.Message")
  50.         .From = "tony.montana@dbs.fr"
  51.         .To = "baptiste.conio@dbs.fr"
  52.         .Subject = "test"
  53.         .TextBody = "test"
  54.         .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
  55.         .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.dbs.fr"
  56.         .Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
  57.         .Configuration.Fields.Update
  58.         On Error Resume Next
  59.         .Send
  60.     End With
  61. End Sub
  62.  
  63. Option Explicit
  64. Private Sub ListOnMsxBox()
  65.  
  66.     Dim I As Long
  67.     Dim Lastrow As Long
  68.     Dim intCounter As Integer
  69.     Dim strMyList As String
  70.    
  71.     Lastrow = Sheets("Blad1").Cells(Rows.Count, "A").End(xlUp).Row
  72.    
  73.     For I = Lastrow To 1 Step -1
  74.         If Sheets("Blad1").Cells(I, 2).Value = TextBox1.Value And Sheets("Blad1").Cells(I, 4) > "" Then
  75.             intCounter = intCounter + 1
  76.             If intCounter <= 10 Then
  77.                 If strMyList = "" Then
  78.                     strMyList = Sheets("Blad1").Cells(I, 1).Value & ", " & Sheets("Blad1").Cells(I, 3).Value
  79.                 Else
  80.                     strMyList = strMyList & vbNewLine & Sheets("Blad1").Cells(I, 1).Value & ", " & Sheets("Blad1").Cells(I, 3).Value
  81.                 End If
  82.             Else
  83.                 Exit For
  84.             End If
  85.         End If
  86.     Next I
  87.    
  88.     MsgBox "Last " & intCounter & " item(s) used by " & TextBox1.Value & vbNewLine & "is: " & strMyList
  89.  
  90. End Sub
  91.  
  92.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement