Discussion :

[frihat mohamed]

bonjour

j' ai trouvé des problèmes dans l'utilisation des données d'un classeur fermé pour la création d'un macro dans un autre classeur , pour être plus précis j'ai fait une application qui sera lancée à partir d'un classeur nommé "application "pour cela j'ai fait un macro dans ce classeur , dans ce macro on a besoin des données d'un autre classeur qui doit être fermé lors de lancement de l'application ,ce classeur est nommé " data base" ,de plus ce dernier classeur est protéger par un mots de passe ; pour ces raisons je trouve des problèmes dans le lancement de l'application.
j'ai essayé avec ce code mais j'ai trouvé des erreurs faute de classeur fermé

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
 
 
' ce code permet à l'accès à un autre userforme si l'utilisateur  écrit correctement son identifiant et son mots de passe et chosit sa fonction
 
 
Private Sub CommandButton1_Click()
 
 
Dim ab As Range ' la cellule qui corrspond au nom cherché d'utlisateur dans la feuille 2de classeur data base
 Dim lig As Integer   'la ligne de la cellule cherché(ab)
 Dim col As Integer ' la colone de la cellule cherché(ab)
Dim nom   as string 'nom de classeur ou se trouve la base de données
  ' on verifie que  l'identifiant et le mots de passe ne sont  pas vide
 
If (TextBox1.Value = " ") Or (TextBox2.Value = "") Then
 MsgBox "Please Enter your Username and Password ", vbOKOnly + vbExclamation
 Else
' dés que l'utilisateur  tape son identifiant et son mots de passe on distingue 3 cas possible s'il a choisi sa fonction comme manager  on fait la recherche dans le classeur data base de cette facon
 
If (OptionButton2.Value = True) Then
      If (TextBox1.Text = Workbooks(nom ).Worksheets("Sheet2").Range("C14").Value) And (TextBox2.Text = Workbooks(nom).Worksheets("Sheet2").Range("D14").Value) Then
      Me.Hide
     UserForm2.Show
      Unload Me
     Else
    MsgBox " Username or Password is incorrect.Please try again", vbOKCancel + vbCritical + vbDefaultButton1, "Erreur"
      End If
End If
 
's'il a choisi sa fonction comme technicien la verification de mots de passe et d'identifiant sera faite de cette facon
If (OptionButton1.Value = True) Then
  With Workbooks(nom).Worksheets("Sheet2")
 
   Set ab = .Range("E:R").Find(TextBox1.Text, lookat:=xlWhole)
  If ab Is Nothing Then
     MsgBox " Username is incorrect.Please try again", vbOKCancel + vbCritical + vbDefaultButton1, "Erreur"
  Else
 lig = ab.Row
 col = ab.Column
      If TextBox2.Text = .Cells(lig, col + 1) Then
     Me.Hide
     UserForm2.Show
     Unload Me
 
     Else
    MsgBox " Password is incorrect.Please try again", vbOKCancel + vbCritical + vbDefaultButton1, "Erreur"
    End If
End If
End With
End If
' si l'utilsateur n'a pas choisi sa fonction alors un msg d'erreur
If (OptionButton1.Value = False) And (OptionButton2.Value = False) Then
MsgBox "Choose your Function", vbOKOnly + vbInformation
 
End If
End If
End Sub
 
Private Sub CommandButton2_Click()
Unload Me
End Sub
 
 
Private Sub Label2_Click()
 
End Sub
 
Private Sub Label3_Click()
 
End Sub
 
Private Sub OptionButton1_Click()

j'ai besoin vraiment de votre aide
merci

[Invité]

Bonjour

D'abord je vais te conseiller la lecture de ce tuto pour la lecture de données dans des classeurs fermés :

Lire et écrire dans les classeurs fermés

Philippe

[frihat mohamed]

bonjour
j'ai lu ce document mais j'ai pas compris comment faire pour résoudre mon probléme je suis débutant en vba
merci de me répondre

personne ne peut m'aider !!!!!!!

[MattChess]

Le code fourni est un UserForm de login pour saisir un nom d'utilisateur et son mot de passe.
Décrivez votre feuille par des constantes en début de module.

Choisir des noms représentatifs pour les boutons Ok, Cancel, les texboxes et autres OptionButton. Ne laissez jamais les noms par défaut avec un n°.

Présentez votre code d'une façon structurée avec alignement des If and End If et indenter les blocs Then et Else avec des TAB selon le niveau d'imbrication.

Les noms de variables doivent être sur au moins cinq lettres pour être compréhensibles.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
Option Explicit ' Login UserForm to control the acces to UserForm2 according to function, username & password
' Always describe your worksheet with constants like:
Const nameXlsDb = "VotreClasseur.xls" ' nom de classeur à ouvrir
Const nameSheet = "Sheet2" ' Your comment about this worksheet. R E N A M E  this worksheet to a best name!
 
Const rowMngt = 14 ' Rangée de l'identifiant et mot de passe du manager
Const colMngtId = 3 ' Colonne C est l'username du manager
Const colMngtPass = colMngtId + 1 ' Colonne D est le mot de passe du manager
' Ditto for the columns E to R for the technicians
 
Private Sub CommandButton1_Click() ' Please  R E N A M E  this button as BtnOk
Dim wkSheetDb As Worksheet
Dim rngAb As Range ' la cellule qui correspond au nom cherché d'utilisateur dans la feuille 2 de classeur data base
Dim indRow As Integer, indCol As Integer ' la rangée et colonne de la cellule cherchée (rngAb) pour le technicien
 
    On Error Resume Next
    Set wkSheetDb = Workbooks(nameXlsDb).Worksheets("Sheet2")
    If Err.Number <> 0 Then Warning "1000: Cannot access to the worksheet " & nameSheet & " in " & nameXlsDb: Exit Sub
    On Error GoTo 0
    ' on verifie que l'identifiant et le mots de passe ne sont pas vides
    If TextBox1.Value = "" Then ' Control that the username has been entered
        Warning "1100: Please Enter your Username": Exit Sub
    End If
    If TextBox2.Value = "" Then ' Control that the password has been entered
        Warning "1200: Please Enter your password": Exit Sub
    End If
    ' s'il a choisi sa fonction comme manager on ouvre directement UserForm2
    If OptionButton2.Value Then ' Please  R E N A M E  OptionButton2 to a best useful name as OptBtnManager
        If TextBox1.Text = wkSheetDb.Cells(rowMngt, colMngtId).Value And _
            TextBox2.Text = wkSheetDb.Cells(rowMngt, colMngtPass).Value Then
            Me.Hide
            UserForm2.Show ' Accès à l'UserForm par le manager. Please  R E N A M E UserForm2 to its useful name!
            Unload Me
        Else
            Warning "1300: Username or Password of the manager is incorrect. Please try again": Exit Sub
        End If
    ElseIf OptionButton1.Value Then ' R E N A M E  OptionButton1 to any useful name as OptBtnTechnician
        Set rngAb = wkSheetDb.Range("E:R").Find(TextBox1.Text, lookat:=xlWhole) ' Find Username
        If rngAb Is Nothing Then
            Warning "1400: Username of the technician is unknown. Please try again": Exit Sub
        End If
        indRow = rngAb.Row
        indCol = rngAb.indColumn
        If TextBox2.Text = wkSheetDb.Cells(indRow, indCol + 1) Then
            Me.Hide
            UserForm2.Show ' Accès à l'UserForm par le technicien
            Unload Me
        Else
            Warning "1500: Password of the technician is incorrect. Please try again": Exit Sub
        End If
    Else ' l'utilisateur n'a pas choisi sa fonction
        Warning "1600: Choose your Function"
    End If
End Sub
 
Private Sub CommandButton2_Click() ' R E N A M E  this button as BtnCancel
    Unload Me
End Sub
 
' Common error management
Sub Warning(ByVal strMsg As String)
Const lenErr = 4 ' Number of digits of the error code beginning the message
    If Err.Number <> 0 Then
        strMsg = strMsg + vbCrLf + "Error " + Str(Err.Number) + ": " + Err.Description
    End If
    MsgBox Mid(strMsg, lenErr + 3), vbExclamation, "Control warning " + Left(strMsg, lenErr)
End Sub

Ce code d'UserForm de login est à tester dans votre contexte. Cela signifie qu'il faut adapter les constantes à votre environnement tel que le nom du classeur à ouvrir et avancer en pas à pas dans le débogueur.

[frihat mohamed]

merci MattChess
j'aime bien votre code mais mon problème est que l'application dans un classeur autre que "data base " plus précisément l'application dans un classeur et les données dans un autre classeur "data base"
pour accéder à l'application l'utilisateur doit ouvrir le classeur ou se trouve l'application un userforme sera affiché et demande à l'utilisateur l'identifiant , le mots de passe et le choix de la fonction .
les données sont placées dans le classeur data base qui doit être fermé
, de plus ce classeur est protéger par un mots de passe " xxxxx"
lorsque j'exécute ce code j'obtiens le message d'erreur suivant
" cannot access to the worksheetsSheets in data base.xls
error 9 subscript out of range"

merci

[Theze]

Bonjour,

Voici pour la récup des noms dans le classeur fermé (adapter les variables et plage), à mettre dans un module standard :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
 
Public TblNom() As String
 
Private Sub ConnectCLasseur(ConnectCL As Object, _
                            Fichier As String, _
                            Optional Rs)
 
    Set ConnectCL = CreateObject("ADODB.Connection")
 
    If Not IsMissing(Rs) Then
 
        Set Rs = CreateObject("ADODB.Recordset")
 
    End If
 
    ConnectCL.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
              "Data Source=" & Fichier & ";" & _
              "Extended Properties=""Excel 8.0;HDR=NO;IMEX=2;"""
 
End Sub
 
Sub RecupNoms()
 
    Dim ConnectCL As Object
    Dim Rs As Object
    Dim Classeur As String
    Dim NomFeuille As String
    Dim Plage As String
    Dim I As Integer
    Dim DerCel As Integer
 
    'chemin du classeur cible
    Classeur = "D:\DataBase.xls"
 
    'nom de la feuille où se trouve la plage des noms à récupérer
    NomFeuille = "sheet2"
 
    'défini la plage sur la colonne A pour la recherche du nombre
    'de cellules non vides adapter la colonne
    Plage = "A1:A65536"
 
    'ouvre une première connecxion pour la recherche
    ConnectCLasseur ConnectCL, Classeur, Rs
 
    'défini la ligne vide sous la dernière cellule non vide de la colonne A
    Set Rs = ConnectCL.Execute("SELECT COUNT(*) FROM `" & NomFeuille & "$" & Plage & "` ")
 
    DerCel = Rs.Fields(0).Value
 
    'plage des noms, doit être définie comme "Ax:Ax"
    Plage = "A1:A" & DerCel
 
    'ferme le recordset
    Rs.Close
 
    'puis le réouvre pour récupérer les noms
    With Rs
 
        .CursorType = 1
        .LockType = 3
        .Open "SELECT * FROM `" & NomFeuille & "$" & Plage & "` ", ConnectCL
        .MoveFirst
 
        'stocke les noms dans un tableau
        ReDim TblNom(1 To .RecordCount)
 
        Do While Not .EOF
 
            I = I + 1
            TblNom(I) = .Fields(0).Value
 
            .MoveNext
 
        Loop
 
    End With
 
    'ferme la connexion
    ConnectCL.Close
 
    'inscrit les noms dans la fenêtre de debogage
    'c'est ici que se fait la récup des noms pour l'utilisation de vérif
    'à adapter selobn les besoins
    For I = 1 To UBound(TblNom)
        Debug.Print TblNom(I)
    Next I
 
    Set Rs = Nothing
    Set ConnectCL = Nothing
 
End Sub

Afin de ne pas lancer cette proc à chaque contrôle, la récupération des noms dans le classeur fermé serait à faire une seule fois à l'ouverture, les noms étant stockés dans une variable tableau publique. L'appel de cette proc peut être faite de la manière suivante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
Private Sub Workbook_Open()
 
    RecupNoms
 
End Sub

Hervé.