Export de données - Condition compteur

Asuki

XLDnaute Nouveau
Bonjour à tous !

C'est après de nombreuses recherches que je sollicite votre aide sur la question !

Actuellement en stage, je dois concevoir un mini logiciel Excel permettant d'exporter notamment des données dans d'autres classeurs fermés. Mon fichier de base doit être muni d'un système d'exportation pour un Plan d'action général "TestPA".

Problème :
Pour l'exportation, je dois vérifier par principe de condition si l'élément existe déjà pour permettre la mise à jour. Dans le cas contraire, c'est à dire quand l'enregistrement est vide, on écrit l'élément... Mais le problème est que cela ne vérifie pas si il y a une tâche à importer et écrit tout bêtement les valeurs, car la seconde partie de mon If de vérification de tâche n'est pas pris en compte !

Donc je me demande s'il y aurait pas un moyen de créer un compteur associé au nombre d'éléments à importer... Une idée ?

Voici mon code que je reprend dans mon fichier :

Code:
Sub ExportPA()

Dim source As Object
Dim RecSet As Object
Dim sFichier As String, sFeuille As String, sPlage As String, sTxtSQL As String
Dim i As Integer, j As Integer
Dim iCompteur As Integer

'****Initialisation***'
sFichier = "C:\Users\StagiaireBE\Desktop\FOFO\TestPA.xlsm" 'Chemin complet du classeur fermé
sFeuille = "Tableau"
j = 9 'Rang de la ligne du fichier, avant début du traitement

'***Traitement***'

Worksheets("PlanAction").Activate 'Active la bonne feuille du classeur

Set source = CreateObject("ADODB.Connection")
source.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
            & sFichier & ";Extended Properties=""Excel 12.0;HDR=YES;"""

'Definition de la plage de cellules
sPlage = "B10:T100"

'Requete SQL
sTxtSQL = "SELECT * FROM [" & sFeuille & "$" & sPlage & "]"
Set RecSet = CreateObject("ADODB.Recordset")
RecSet.Open sTxtSQL, source, adOpenKeyset, adLockOptimistic

'Compte de nombre de champs
RecSet.MoveLast
iCompteur = RecSet.RecordCount

RecSet.MoveFirst 'Se replace au début de l'enregistrement pour traitement

While Not RecSet.EOF
    If(RecSet(1).Value = CStr(Range("B" & j).Value) Or IsEmpty(RecSet(1).Value) Or IsNull(RecSet(1).Value)) And (Not IsEmpty(Range("B" & j).Value) Or Not IsNull(Range("B" & j).Value)) Then
        'Vérification du sujet pour éviter les doublons et mettre à jour
        j = j + 1
        'For i=1 To 16
        RecSet(1).Value = 1 'Collage Test sans automatisation par boucle For
        '= Cells(j, i+2)
        RecSet.Update
        'Reste de l'affectation des valeurs
        'Next
    End If
    RecSet.MoveNext
Wend

'Fermeture de l'enregistrement
RecSet.Close
source.Close
Set RecSet = Nothing
Set source = Nothing

End Sub

Merci d'avance :)
 
Dernière modification par un modérateur:

Discussions similaires

Statistiques des forums

Discussions
312 194
Messages
2 086 070
Membres
103 110
dernier inscrit
Privé