Echange de données entre xlsm et mdb.

Makina

XLDnaute Junior
Bonjours a tous,

Je dois réaliser un programme en vba sous excel, et comme je débute, j'ai beaucoup de mal !
J ai mis en pj deux fichiers; cartonette en xlsm et test1 en mdb (la version du vrai fichier est plus vieille).
Je dois réaliser un programme de tel sorte que
- j ouvre le template cartonette sur un poste dans un domaine
- je renseigne les cellules de A9 à A17
- quand je rentre un chiffre en A9 (puis A10, A11,..) le programme doit aller ouvrir le fichier test1 sur le réseau
- retrouver le chiffre saisi en A9 dans la premiere colonne de test1
- puis recopier la valeur de la colonne 3 (de test1 sur la ligne trouvée) en F5 de cartonette
- recopier les valeurs dans les colonnes 4 et 5 toujours dans F5 a la suite (séparer par un espace)
- recopier la valeur de la colonne 6 en A2 ....

Voila J 'ai vraiment bcp de mal avec VBA, toutes aides seront les bienvenues !

J 'avais commencé par :
Code:
Dim cmd As Integer
Dim numéro As Integer
Dim celluletrouvee As Range
Dim ligne As Integer
Dim col As Integer
Dim name As String

Sub Ouvrir_mbd()

numéro = Workbooks("Cartonette").Sheets("Feuil1").Cells(9, 1).Value

 Ouvrir_mbd Macro

    Workbooks.OpenDatabase Filename:="C:\Users\Portable\Desktop\EW_3003.MDB", _
        CommandText:=Array("EW_3003"), CommandType:=xlCmdTable, ImportDataAs:= _
    xlTable

Set celluletrouvee = Range("A:A").Find(numéro, lookat:=xlWhole)'

If celluletrouvee Is Nothing Then
MsgBox ("pas trouvé")
Else
ligne = celluletrouvee.Row
col = celluletrouvee.Column
MsgBox ("trouvé : ligne = " & ligne & " , colonne = " & col)
End If

name = Range(ligne, 3).Value
Workbooks("Cartonette").Sheets("Feuil1").Range(5, 6).Activate
Workbooks("Cartonette").Sheets("Feuil1").Range(5, 6) = name


End Sub

Sans succes ....

Merci a tous par avance !
 

Pièces jointes

  • Cartonette.xlsm
    19.4 KB · Affichages: 46
  • Cartonette.xlsm
    19.4 KB · Affichages: 56
  • Cartonette.xlsm
    19.4 KB · Affichages: 59
  • test1.zip
    9.3 KB · Affichages: 24
  • test1.zip
    9.3 KB · Affichages: 26
  • test1.zip
    9.3 KB · Affichages: 25
Dernière édition:
C

Compte Supprimé 979

Guest
Re : Echange de données entre xlsm et mdb.

Bonjour Makina,

Pas mal ton premier jet, mais change le ainsi
Code:
Sub Test()
  Dim cmd As Integer
  Dim numéro As Integer
  Dim celluletrouvee As Range
  Dim ligne As Integer
  Dim col As Integer
  Dim name As String
  Dim sPath As String
  Dim sBase As String
  
  ' Récupérer le numéro en cellule A9
  numéro = Sheets("Feuil1").Cells(9, 1).Value
  ' Définir le chemin d'accès à la base
  'sPath = ThisWorkbook.Path & "\"
  sPath = "C:\Users\Portable\Desktop\"
  ' Définir el nom de al base
  sBase = "EW_3003.MDB"
  ' Ouvrir la base en tant que nouveau classeur
  Workbooks.OpenDatabase Filename:=sPath & sBase, _
                         CommandText:=Array("EW_3003"), CommandType:=xlCmdTable, ImportDataAs:=xlTable
  ' Avec ce classeur actif
  With ActiveWorkbook.Sheets(1)
    ' Trouvée la cellule dans la colonne A
    Set celluletrouvee = .Range("A:A").Find(numéro, lookat:=xlWhole)  '
    ' Si la cellule n'est pas trouvée = rien
    If celluletrouvee Is Nothing Then
      MsgBox ("pas trouvé")
      Exit Sub
    Else
      ligne = celluletrouvee.Row
      col = celluletrouvee.Column
      MsgBox ("trouvé : ligne = " & ligne & " , colonne = " & col)
    End If
    name = .Range(ligne, 3).Value
  End With
  '
  Workbooks("Cartonette").Sheets("Feuil1").Range(5, 6) = name
End Sub

Ensuite dans ta MDB, tu cherche la valeur 25 dans la colonne A,
or cette valeur n'existe pas, donc la suite du code ne pas être exécuté ;)

a+
 
Dernière modification par un modérateur:

Gelinotte

XLDnaute Accro
Re : Echange de données entre xlsm et mdb.

Bonsoir,

Il y avait des petits bugs ici et là.

J'ai utilisé le répertoire "C:\a_test\" pour déposer les deux fichiers : Cartonette.xlsm et EW_3003Base.mdb

Entre autres : impossible d'écrire dans la cellule F5 puisque cette cellule faisait partie d'une fusion de cellule (j'ai défusionné).
Dans le code de BrunoM45, j'avais des arrêts sur les lignes contenant ".Range". J'ai remplacé par ".Cells" avec succès.
La procédure créé un fichier temporaire, j'ai ajouté sa fermeture.

A+

G
 

Makina

XLDnaute Junior
Re : Echange de données entre xlsm et mdb.

Bonsoir,

Merci à vous pour votre aide, je pourrai tester que demain. J ai fait un peu de programmation à l'école (Fortant..) et il me manque les bases de vba !

C'est sympa de trouver un forum avec des personnes réactives avec le plaisir d'aider ! Merci encore.

A demain
 

Makina

XLDnaute Junior
Re : Echange de données entre xlsm et mdb.

Bonjour,

Merci, le fichier fnctionne ! je l ai adapté a mes fichier et ca tourne !

Cette fois je voulais faire une procedure pour si il y a une valeur dans les cases A10 à A18 alors la chercher dans l autre fichier et la copier en B10 à B18 (meme ligne que A).

Voila mon code :
Code:
Sub Ligne2()
   Dim numéro As Double
   Dim celluletrouvee As Range
   Dim ligne As Integer
   Dim col As Integer
   Dim nameC8 As String
   Dim sPath As String
   Dim sBase As String
   Dim i As Integer
   
   i = 1
   
    For i = 1 To 8 Step 1

  ' Récupérer le numéro en cellule A10 à A17
        numéro = Workbooks("Cartonette1.xlsm").Sheets("Feuil1").Cells(9 + i, 1).Value
        If Workbooks("Cartonette1.xlsm").Sheets("Feuil1").Cells(9 + i, 1).Value Is Nothing Then
        i = i + 1
        Exit Sub
    Else
      
   ' Définir le chemin d'accès à la base
   'sPath = ThisWorkbook.Path & "\"
   sPath = "C:\Users\Portable\Desktop\"
   ' Définir el nom de al base
   sBase = "EW_3003base.MDB"
   ' Ouvrir la base en tant que nouveau classeur
   Workbooks.OpenDatabase Filename:=sPath & sBase, _
                          CommandText:=Array("EW_3003"), CommandType:=xlCmdTable, ImportDataAs:=xlTable
   ' Avec ce classeur actif
   With ActiveWorkbook.Sheets(1)
     ' Trouvée la cellule dans la colonne AF(32)
     Set celluletrouvee = .Range("AF:AF").Find(numéro, lookat:=xlPart)  '
     ' Si la cellule n'est pas trouvée = rien
     If celluletrouvee Is Nothing Then
       MsgBox ("pas trouvé")
        ActiveWorkbook.Close False
   
   Workbooks("Cartonette1.xlsm").Activate
       Exit Sub
     Else
       ligne = celluletrouvee.Row
       col = celluletrouvee.Column
'       MsgBox ("trouvé : ligne = " & ligne & " , colonne = " & col)
     End If
     nameC8 = .Cells(ligne, 1).Value
   
   End With
   ActiveWorkbook.Close False
   
   Workbooks("Cartonette1.xlsm").Activate
   Workbooks("Cartonette1.xlsm").Sheets("Feuil1").Cells(9 + i, 2) = nameC8
   i = i + 1
   End If
   Next
   
 End Sub

Et bien entendu, ca va pas ! Je pense que ma facon d ecrire les boucle n est pas la bonne, j ai essayé next i, il me disait qu il manquait un for, donc j ai fait i=i+1

Merci d avance !
 
Dernière édition:

Makina

XLDnaute Junior
Re : Echange de données entre xlsm et mdb.

Bon deja j ai enlevé le .Value à la ligne :

If Workbooks("Cartonette1.xlsm").Sheets("Feuil1").Cel ls(9 + i, 1).Value Is Nothing Then

Et ca passe mieux !
Maintenant mon problème est que si il n y a rien dans mes cellules A10 à A18, il me recopie la valeur (1,1) dans ma base de données.

Si vous pouvez m aider ...
 

Gelinotte

XLDnaute Accro
Re : Echange de données entre xlsm et mdb.

Bonsoir,

Essaie cela.
J'ai tenté de gérer les numéros non trouvés et les cellules vides dans la colonne A.
Toujours dans mon dossier teste : C:\a_test\.
J'utilise un fichier temporaire CartonTemp.xls qui est supprimé à la fin (dans le dossier de travail C:\a_test\) car on doit basculer à plusieurs reprises d'un à l'autre.

Ce n'est pas très documenté. Je compte sur toi pour cela 8- ))))

G
 

Pièces jointes

  • Cartonette.xlsm
    32.6 KB · Affichages: 61
  • Cartonette.xlsm
    32.6 KB · Affichages: 57
  • Cartonette.xlsm
    32.6 KB · Affichages: 52

Makina

XLDnaute Junior
Re : Echange de données entre xlsm et mdb.

Bonjour et encore merci Gelinotte!

Grace à toi j ai écris cela : (se sont les vraix path)
Code:
Sub Ligne2()
   Dim X As Integer
   Dim B As String
   Dim F As String
   On Error Resume Next

   For X = 10 To 17
Reprise:
   ' vérifier si les cellules A10 à A17 sont vides
   If Workbooks("Cartonette1.xlsm").Sheets("Feuil1").Cells(X, 1).Value = "" Then
      X = X + 1
   GoTo Reprise
   End If
   
   ' numéro prend la valeur des cellules A10 à A17
   numéro = Workbooks("Cartonette1.xlsm").Sheets("Feuil1").Cells(X, 1).Value
   
   ' Définir le chemin d'accès à la base
   'sPath = ThisWorkbook.Path & "\"
   sPath = "C:\Users\Portable\Desktop\"
   ' Définir el nom de al base
   sBase = "EW_3003base.MDB"
   ' Ouvrir la base en tant que nouveau classeur
   Workbooks.OpenDatabase Filename:=sPath & sBase, _
                          CommandText:=Array("EW_3003"), CommandType:=xlCmdTable, ImportDataAs:=xlTable
   
   ' Avec ce classeur actif
   With ActiveWorkbook.Sheets(1)
     ' Trouvée la cellule dans la colonne AF (32)
     Set celluletrouvee = .Range("AF:AF").Find(numéro, lookat:=xlPart)  '
     ' Si la cellule n'est pas trouvée = rien
     If celluletrouvee Is Nothing Then
       MsgBox ("pas trouvé")
      
        ActiveWorkbook.Close False
 '    Exit Sub
      X = X + 1
     Else
       ligne = celluletrouvee.Row
       col = celluletrouvee.Column
       B = .Cells(ligne, 1).Value
       ActiveWorkbook.Close False
     End If
     Workbooks("Cartonette1.xlsm").Sheets("Feuil1").Cells(X, 2) = B
     
   End With
   
      
   Next X
'     ActiveWorkbook.Close False
     Workbooks("Cartonette1.xlsm").Activate
     
 End Sub

J ai fais sans fichier temporaire en reprenant le premier programme, car je dois le fair en deux sub séparés. Cela fontionne sauf quand X =17 il va a X=18 je pense et me met "pas trouvé". J ai essayer en mettant for x=10 to 16, mais il ne me prend pas la derniere valeur (A17) ....

Je travail dessus mais merci encore de ton aide.
 
Dernière édition:

Makina

XLDnaute Junior
Re : Echange de données entre xlsm et mdb.

J ai ajouté un goto qui me permet de forcer la sortie et ca fonctionne ! Par contre je pense pas que c est très "propre" comme méthode ...
Code:
Sub Ligne2()
   Dim X As Integer
   Dim B As String
   Dim F As String
   On Error Resume Next

   For X = 10 To 17
Reprise:
   ' vérifier si les cellules A10 à A17 sont vides
   If Workbooks("Cartonette1.xlsm").Sheets("Feuil1").Cells(X, 1).Value = "" Then
      X = X + 1
      If X = 18 Then
      GoTo Endsub
      End If
      
   GoTo Reprise
   End If
   
   ' numéro prend la valeur des cellules A10 à A17
   numéro = Workbooks("Cartonette1.xlsm").Sheets("Feuil1").Cells(X, 1).Value
   
   ' Définir le chemin d'accès à la base
   'sPath = ThisWorkbook.Path & "\"
   sPath = "C:\Users\Portable\Desktop\"
   ' Définir el nom de al base
   sBase = "EW_3003base.MDB"
   ' Ouvrir la base en tant que nouveau classeur
   Workbooks.OpenDatabase Filename:=sPath & sBase, _
                          CommandText:=Array("EW_3003"), CommandType:=xlCmdTable, ImportDataAs:=xlTable
   
   ' Avec ce classeur actif
   With ActiveWorkbook.Sheets(1)
     ' Trouvée la cellule dans la colonne AF (32)
     Set celluletrouvee = .Range("AF:AF").Find(numéro, lookat:=xlPart)  '
     ' Si la cellule n'est pas trouvée = rien
     If celluletrouvee Is Nothing Then
       MsgBox ("pas trouvé")
      
        ActiveWorkbook.Close False
 '    Exit Sub
      X = X + 1
     Else
       ligne = celluletrouvee.Row
       col = celluletrouvee.Column
       B = .Cells(ligne, 1).Value
       ActiveWorkbook.Close False
     End If
     Workbooks("Cartonette1.xlsm").Sheets("Feuil1").Cells(X, 2) = B
     
   End With
   
      
   Next X
'     ActiveWorkbook.Close False
     Workbooks("Cartonette1.xlsm").Activate
Endsub:
     
 End Sub
 
Dernière édition:
C

Compte Supprimé 979

Guest
Re : Echange de données entre xlsm et mdb.

Makina,

MERCI de prendre l'habitude de mettre ton code entre balises
Code:
 et [/ code] (sans espace après "[/")

Si tu pouvais éditer tes précédents post et le faire, ce serait sympa ;)

A+
 
C

Compte Supprimé 979

Guest
Re : Echange de données entre xlsm et mdb.

Re,

Merci Makina, voici le code avec quelque chose d'un peu plus propre ;)
A tester tout de même
VB:
Sub Ligne2()
  Dim Lig As Long, ShtS As Worksheet
  Dim Ligne As Long, Col As Integer
  Dim sPath As String, sBase As String
  Dim Numéro As String, B As String
  On Error Resume Next
  ' Les variables statiques peuvent être définit ICI or de la boucle
  'sPath = ThisWorkbook.Path & "\"
  sPath = "C:\Users\Portable\Desktop\"
  ' Définir ll nom de la base
  sBase = "EW_3003base.MDB"


  ' Définir la variable objet de la feuille nommée du classeur nommé
  Set ShtS = Workbooks("Cartonette1.xlsm").Sheets("Feuil1")
  '
  ' Ouvrir la base en tant que nouveau classeur
  Workbooks.OpenDatabase Filename:=sPath & sBase, _
                         CommandText:=Array("EW_3003"), CommandType:=xlCmdTable, ImportDataAs:=xlTable
  
  ' Faire une boucle de la ligne 10 à 17
  For Lig = 10 To 17
    ' vérifier si les cellules A10 à A17 ne sont pas  vides
    If ShtS.Cells(Lig, 1).Value <> "" Then
      ' Auquel cas on fait le traitement
      ' numéro prend la valeur des cellules A10 à A17
      Numéro = ShtS.Cells(Lig, 1).Value
      ' Avec ce classeur actif
      With ActiveWorkbook.Sheets(1)
        ' Trouvée la cellule dans la colonne AF (32)
        Set celluletrouvee = .Range("AF:AF").Find(Numéro, lookat:=xlPart)  '
        ' Si la cellule n'est pas trouvée = rien
        If celluletrouvee Is Nothing Then
          MsgBox ("pas trouvé")
          ' ActiveWorkbook.Close False
          ' Exit Sub
        Else
          Ligne = celluletrouvee.Row
          Col = celluletrouvee.Column
          B = .Cells(Ligne, 1).Value
          'ActiveWorkbook.Close False
        End If
        ShtS.Cells(Lig, 2) = B
      End With
    End If
  Next Lig
  ActiveWorkbook.Close False
  'Workbooks("Cartonette1.xlsm").Activate
End Sub

A+
 

Makina

XLDnaute Junior
Re : Echange de données entre xlsm et mdb.

Woooowwww ! Merci BrunoM45 !

De 1, ca fonctionne, de 2 c est instantané vu qu il ouvre qu une fois ma base de donnée!
Je fonctionne par étape, cette fois je dois lire des codes barre a l aide d un lecteur et les rentrer dans mon tableau, mais il faut deja que j arrive à ce que mon lecteur de code barre communique avec windows ....

MERCI

A+
 

Gelinotte

XLDnaute Accro
Re : Echange de données entre xlsm et mdb.

Bonjour,

Code:
     With ActiveWorkbook.Sheets(1)
         ' Trouvée la cellule dans la colonne AF (32)
        Set celluletrouvee = .Range("AF:AF").Find(Numéro, lookat:=xlPart)  '
        ' Si la cellule n'est pas trouvée = rien
        If celluletrouvee Is Nothing Then
           MsgBox ("pas trouvé")
           ' ActiveWorkbook.Close False
          ' Exit Sub
        Else
           Ligne = celluletrouvee.Row
           Col = celluletrouvee.Column
           B = .Cells(Ligne, 1).Value
           'ActiveWorkbook.Close False
        End If
         ShtS.Cells(Lig, 2) = B
       End With

Deux petites corrections :
- Range("AF:AF"). >> Range("A:F").
- B = .Cells(Ligne, 1).Value >> B = .Cells(Ligne, 2).Value

Voilà, sinon, c'est impect mon mec (comme on dit dans mon coin) 8- ))))))))))

Un grand merci à vous tous, je sais maintenant utiliser un fichier Access comme source de données. :cool:

G
 

Discussions similaires

Statistiques des forums

Discussions
311 715
Messages
2 081 822
Membres
101 821
dernier inscrit
hybroxis