Discussion :

[amelyfred]

Bonjour,
J'ai créé ce bout de code

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
92
93
94
95
96
97
98
99
100
101
 
  Dim Demandeur As String
    Dim Service As String
    Dim Date_Enregistrement As Date
    Dim Projet As String
    Dim N_Enregistrement As Long
    Dim Ma_Var As Variant
    Dim Analyse_1 As Variant
    Dim Analyse_2 As Variant
    Dim Analyse_3 As Variant
    Dim Analyse_4 As Variant
    Dim Analyse_5 As Variant
    Dim Analyse_6 As Variant
    Dim Analyse_7 As Variant
    Dim Analyse_8 As Variant
    Dim Analyse_9 As Variant
    Dim Analyse_10 As Variant
    Dim Cell_ref As Range
    Dim N_Ligne As Long
    Dim Ma_Select_2 As Range
 
 
 
'Procédure permettant de récupérer toutes les données pour le transfert dans le fichier base
 
Public Sub Recup_Donnees()
 Demandeur = Range("C4").Value
    Service = Range("C5").Value
    Date_Enregistrement = Range("C7").Value
    Projet = Range("C6").Value
    Analyse_1 = ""
    Analyse_2 = ""
    Analyse_3 = ""
    Analyse_4 = ""
    Analyse_5 = ""
    Analyse_6 = ""
    Analyse_7 = ""
    Analyse_8 = ""
    Analyse_9 = ""
    Analyse_10 = ""
 
 
For Each Cell_ref In Range("Reference")
    If Cell_ref.Value <> "" Then
        N_Ligne = Cell_ref.Row
        Call Recup_Analyse
        Call Enregistremen_Base
    End If
Next Cell_ref
 
 
End Sub
 
Public Sub Recup_Analyse()
 
 'Sélection de la plage pour vérification des analyses demandées
 
 Set Ma_Select_2 = Sheets("Formulaire").Range("D" & N_Ligne & ": M" & N_Ligne)
 i = 1
 
 For Each Cell In Ma_Select_2
    If Cell.Value = "O" Then
       N_Col = Cell.Column
 
      Select Case i
        Case 1
            Analyse_1 = Range(Cells(4, N_Col)).Value
 
       Case 2
            Analyse_2 = Range(Cells(4, N_Col)).Value
 
        Case 3
            Analyse_3 = Range(Cells(4, N_Col)).Value
 
        Case 4
            Analyse_4 = Range(Cells(4, N_Col)).Value
 
        Case 5
            Analyse_5 = Range(Cells(4, N_Col)).Value
 
        Case 6
            Analyse_6 = Range(Cells(4, N_Col)).Value
 
        Case 7
            Analyse_7 = Range(Cells(4, N_Col)).Value
 
        Case 8
            Analyse_8 = Range(Cells(4, N_Col)).Value
 
        Case 9
            Analyse_9 = Range(Cells(4, N_Col)).Value
 
        Case 10
            Analyse_10 = Range(Cells(4, N_Col)).Value
    End Select
       i = i + 1
    End If
Next Cell
 
 
End Sub

mais je ne comprends pas 2 choses :
- tout d'abord, il ne veut pas que je mette mes variable Analyse_1,... en tant que variable String : Pourquoi??

-Lorsque je lance le code, ca commence bien car je récupère bien ma première valeur Analyse_1 mais la seconde boucle message d'erreur "La méthode 'Range' de l'objet '_Global' a échoué "

Pourquoi d'après vous?
Merci d'avance
Fred

[mercatog]

Pour ta question 2

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
Public Sub Recup_Analyse()
Dim i As Long
'Sélection de la plage pour vérification des analyses demandées
 
With Sheets("Formulaire")
    Set Ma_Select_2 = .Range("D" & N_Ligne & ": M" & N_Ligne)
    i = 1
    For Each Cell In Ma_Select_2
        If Cell.Value = "O" Then
            N_Col = Cell.Column
            Select Case i
                Case 1
                    Analyse_1 = .Cells(4, N_Col).Value
                Case 2
                    Analyse_2 = .Cells(4, N_Col).Value
                'la suite
            End Select
            i = i + 1
        End If
    Next Cell
    'Set Ma_Select_2 = Nothing
End With
End Sub

PS: Un Range n'indiquant pas sa feuille mère c'est de la peste dans un code.

PS2: Peut être il serait plus judicieux de travailler, dans ton cas, à l'aide d'un tableau au lieu des variables Analyse_x et avec des procédures paramétrées au lie des variables publiques. Bon c'est une suggestion que tu peux ignorer.

[amelyfred]

Merci de ton aide mais ca ne fonctionne pas mieux.

Je vais essayer d'étudier l'histoire des tableau mais je suis assez novice en vba et je me débrouille un peu comme je peux.

[mercatog]

ca ne fonctionne pas mieux

ne veut rien dire.

essaies de mettre tout ton code avec notamment (en plus) ta subEnregistremen_Base
et en expliquant les feuilles avec lesquelles tu travaille. (Description de ton classeur)

[amelyfred]

Voilà je mets le fichier en pieces jointes ca sera plus simple.
L'idée est de faire une demande d'analyse.
Le personne choisit un produit et les différents noms d'analyses s'affichent.

Ensuit la personne entre un numéro d'échantillon et choisit par O ou N si elle souhaite l'analyse du produit.

Ce que je souhaite faire c'est d'envoyer vers un autre fichier le nom de l'échantillons et les analyses demandées (cad où le "O" est sélectionnées).
C'est là où je bloque.

Mon idée était :
dans ma sélection Référence, je récupère toutes les cellules remplies puis je regarde pour chaque ligne, quelles sont les cellules où "O" est sélectionné puis je récupère dans une variable "Analyse_x" le nome de l'analyse et j'envoie le tout dans mon autre fichier.


Il y a peut etre plus simple à faire.
Qu'en pensez vous?
Merci d'avance pour votre aide
Fred

[mercatog]

Je n'ai pas ton fichier vers lequel exporter mais teste cette première proposition (Aucune variable globale)

Peux être tu auras un problème dans la ligne 66

Teste en pas à pas (F8)

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
Option Explicit
 
'Procédure permettant de récupérer toutes les données pour le transfert dans le fichier base
Sub Recup_Donnees()
Dim Demandeur As String, Service As String, Projet As String
Dim Date_Enregistrement As Date
Dim c As Range
 
With Sheets("Formulaire")
    Demandeur = .Range("C4").Value
    Service = .Range("C5").Value
    Date_Enregistrement = .Range("C7").Value
    Projet = .Range("C6").Value
    For Each c In .Range("Reference")
        If c.Value <> "" Then Call Enregistremen_Base(Date_Enregistrement, Demandeur, Service, Projet, Recup_Analyse(c.Row))
    Next c
End With
End Sub
 
Function Recup_Analyse(ByVal Lig As Long) As String
Dim c As Range
Dim Tablo() As String
Dim Res As String
 
With Sheets("Formulaire")
    ReDim Tablo(1 To 10)
    For Each c In .Range("D" & Lig & ": M" & Lig)
        If c.Value = "O" Then Tablo(c.Column - 3) = .Cells(4, c.Column)  '-3 on commence en colonne D=4
    Next c
End With
Res = Join(Tablo, "','")
'ICI ON PEUT FAIRE AUTREMENT POUR N'AVOIR QUE LES RESULTATS NON VIDES
Recup_Analyse = Res
End Function
 
'Procédure permettant de faire l'enregistrement des différentes données dans le fichhier base
 
Sub Enregistremen_Base(ByVal DteEnrg As Date, ByVal Dem As String, ByVal Serv As String, ByVal Proj As String, ByVal Analys As String)
Dim Cn As New ADODB.Connection
Dim Rst As ADODB.Recordset
Dim Fichier As String, Feuille As String, strSQL As String
Dim NumEnrg As Long
 
'Définit le classeur fermé servant de base de données
Fichier = "P:\commun\Techniciens\F.ROLLIN\divers\Proj_DA\Base_Donnees_DA.xls"
'Nom de la feuille dans le classeur fermé
Feuille = "Base"
 
'--- Connexion ---
With Cn
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
                        & Fichier & ";Extended Properties=""Excel 12.0;HDR=YES;"""
    .Open
End With
'-----------------
'Définit la requête permettant de récupérer le dernier numéro d'enregistrement
strSQL = "SELECT Max([NumEnrg]) FROM [" & Feuille & "$]"
Set Rst = New ADODB.Recordset
Set Rst = Cn.Execute(strSQL)
 
NumEnrg = Rst(0) + 1
'--------------------------------------------------------
'Définit la requête permettant d'écrire toutes les données.
 
strSQL = "INSERT INTO [" & Feuille & "$] " & "VALUES (" & "'" & NumEnrg & "', " & "'" & DteEnrg & "', " & "'" & Dem & "',  " & "'" & Serv & "'," & "'" & Proj & "'," & "'" & Analys & "')"
Cn.Execute strSQL
 
'--- Fermeture connexion ---
Cn.Close
Set Cn = Nothing
End Sub

EDIT
Remplace dans la ligne 58, NumEnrg par le nom du champs de ta feuille Base. Et seulement dans cette ligne.