salut! à tous, j'ai un sérieux probleme depuis quelques jours.
 
je souhaite recupérer des données dans un fichier excel, et le recopier dans un autre. la manipulation se fait sous VB, et ça ne marche pas! je vous fait une copie de mon programme, il est long certe, mais pas compliqué, je compte sur vous!
 
N.B il marche super bien sous excel, et pas du tout sous VB!
 
 Sub Macro2()
'classe application pour les fichiers contact, protocoles, licences.
Dim app_con           As Excel.Application
Dim app_pro           As Excel.Application
Dim app_lic           As Excel.Application
Dim app_base          As Excel.Application
 
'classe window pour les fichiers contact, protocoles, licences.
Dim fichier_con       As Excel.Window
Dim fichier_pro       As Excel.Window
Dim fichier_lic       As Excel.Window
Dim fichier_base      As Excel.Window
 
'classe worksheet pour les feuilles contact, protocoles, licences.
Dim feuille_con       As Excel.Worksheet
Dim feuille_pro       As Excel.Worksheet
Dim feuille_lic       As Excel.Worksheet
Dim feuille_base      As Excel.Worksheet
 
'classe workbook pour les feuilles contact, protocoles, licences.
Dim classeur_con      As Excel.Workbook
Dim calsseur_pro      As Excel.Workbook
Dim classeur_lic      As Excel.Workbook
Dim classeur_base     As Excel.Workbook
 
'déclaration des directories.
Dim Path_con          As String
Dim Path_pro          As String
Dim Path_lic          As String
Dim path_base         As String
 
'Les différents fichiers contact, protocoles, licences.
Dim fich_con          As String
Dim fich_pro          As String
Dim fich_lic          As String
Dim fich_base         As String
 
'Variables des cellules feuilles contact, protocoles, licences.
Dim cell_lic          As Integer
Dim cell_pro          As Integer
Dim cell_con          As Integer
 
'Variables offsets contact, protocoles, licences.
Dim off_con           As Integer
Dim off_pro           As Integer
Dim off_lic           As Integer
 
'Fin des tableaux contact, protocoles, licences.
Dim fin_con           As Integer
Dim fin_pro           As Integer
Dim fin_lic           As Integer
 
'Variables de la fonction principal.
Dim val_cell          As Integer
Dim result            As Boolean
 
'définition des classes excel application comme objet
Set app_con = CreateObject("Excel.application" )
Set app_pro = CreateObject("Excel.application" )
Set app_lic = CreateObject("Excel.application" )
Set app_base = CreateObject("Excel.application" )
 
'initialisation des fichiers contact, protocoles, licences.
fich_con = "contact.xls"
fich_pro = "protocoles.xls"
fich_lic = "licences.xls"
fich_base = "base_de_données.xls"
 
'initialisation des directories contact, protocoles, licences.
Path_con = "C:\projet_client\" & fich_con
Path_pro = "C:\projet_client\" & fich_pro
Path_lic = "C:\projet_client\" & fich_lic
path_base = "C:\projet_client\" & fich_base
 
'définition des classes workbook contact, protocoles, licences
Set classeur_con = app_con.Workbooks.Open(Path_con)
Set classeur_pro = app_pro.Workbooks.Open(Path_pro)
Set classeur_lic = app_lic.Workbooks.Open(Path_lic)
Set classeur_base = app_base.Workbooks.Open(path_base)
 
'initialisation du contenu des cellules du fichier principal et la fin des différents tableaux
val_cell = 2
fin_con = 5
fin_pro = 27
fin_lic = 13
 
'Initialisation de l'offset, et de la fin du contenu du fichier contact
off_con = 0
off_pro = 0
off_lic = 0
 
'Identification du fichier actif.
Set fichier_base = app_base.Windows(fich_base)
fichier_base.Activate
Set feuille_base = app_base.Sheets("Récapitulatif" )
feuille_base.Activate
 
'Test des différents champs avec avec "ou". si ligne remplie, passage à la ligne suivante.
Do
    result = CBool(Range("B" & Asc(val_cell)).Value) Or CBool(Range("C" & Asc(val_cell)).Value) Or CBool(Range("D" & val_cell).Value)
    If result = False Then
     
        'Remplissage des champs contact.
        For cell_con = 1 To fin_con
     
            Set fichier_con = app_con.Windows(fich_con)
            fichier_con.Activate
            Set feuille_con = app_con.Sheets("contact" )
            feuille_con.Range("B" & cell_con).Cut
            fichier_base.Activate
            Range("B" & val_cell).Activate
            ActiveCell.Offset(0, off_con).Select
            ActiveSheet.Paste
            feuille_con.Range("B" & cell_con).Clear
            off_con = off_con + 1
             
        Next cell_con
     
        'Sauvegarde et fermeture du fichier contact.
            app_con.Workbooks(fich_con).Save
            app_con.Workbooks(fich_con).Close
 
       'Remplissage des champs protocoles.
        For cell_pro = 1 To fin_pro
     
            Set fichier_pro = app_pro.Windows(fich_pro)
            fichier_pro.Activate
            Set feuille_pro = app_pro.Sheets("protocoles" )
            feuille_pro.Range("B" & cell_pro).Cut
            fichier_base.Activate
            Range("G" & val_cell).Activate
            ActiveCell.Offset(0, off_pro).Select
            ActiveSheet.Paste
            feuille_pro.Range("B" & cell_pro).Clear
            off_pro = off_pro + 1
         
        Next cell_pro
     
        'Sauvegarde et fermeture du fichier protocoles.
        app_pro.Workbooks(fich_pro).Save
        app_pro.Workbooks(fich_pro).Close
         
        fichier_base.Activate
            If Range("A" & val_cell).Value = "" Then
             
                  For cell_lic = 1 To fin_lic
         
                     Set fichier_lic = app_lic.Windows(fich_lic)
                     fichier_lic.Activate
                     Set feuille_lic = app_lic.Sheets("licences" )
                     feuille_lic.Range("B" & cell_lic).Cut
                     fichier_base.Activate
                     Range("A" & val_cell).Activate
                     ActiveCell.Offset(off_lic, 0).Select
                     ActiveSheet.Paste
                     off_lic = off_lic + 2
                 
                  Next cell_lic
         
        'Sauvegarde et fermeture du fichier licences.
        app_lic.Workbooks(fich_lic).Save
        app_lic.Workbooks(fich_lic).Close
 
            End If
       
    Else: Range("B" & val_cell + 2).Activate
    End If
    val_cell = val_cell + 2
Loop While result = True
End Sub
 
 

super
 
"Ca marche pas" c'est un peu vague et j'ai oublié mon mard de café à la maison.

 
+1
 
en plus tu fait souvent reference directement a des objets RANGE , ce que VB ne peut pas comprendre :
 

 
tu doit absolument mettre la reference de l'objet Excel, puis l'objet feuille avant de faire reference a une cellule.
 
VB ne connait pas le terme RANGE tout seul, contrairement a VBA Excel...

je croix qu'il partait un peu dans tous les sens mon programme. je l'ai clarifié et il marche à nouveau. désolé pour le code!
 
"j'ai oublié mon mard de café à la maison"