Programme Vb qui pilote excel

Résolu
khouloud -  
 -Shadow- -
bonjour,
je veux ecrire un programme qui fait appel a excel .
à travers des variable ajouter dans des zones textes il affecte ces variables dans les cellules de excel.
merci de me répondre.

17 réponses

  1. Utilisateur anonyme
     
    Attendu que mon lien n'est plus, je place ici le code du script : 

    '==============================================================================================
'
' Fichier Source VBScript
'
' NOM DU FICHIER : <ARBORESCENCE_Sous_EXCEL.VBS>
'
' AUTEUR : Arsène Lupin
' DATE DE CRÉATION  : 2002-11-05
' DATE DE MODIFICATION : 2006-01-17
' Version 3.1
'
' COMMENT: <Compiler dans un fichier EXCEL toutes les informations
'            des fichiers d'un lecteur et/ou d'un répertoire cible
'(Ligne 14)====================================================================================
'
'Accèss au dossier d'un disque
'
Const cteCache = "Caché"
Const cteSysteme = "Système"
Const cteArchive = "cteArchive"
Const cteLecture = "cteLecture_Seulement"
Const cteRaccourci = "cteRaccourci"
Const cteCompresse = "Compressé"
Const ctePlgFitGlobale = "A1:P1"
'
'(Ligne 26)====================================================================================
'
' Déclaration des variables globales du programme
'
Dim oLecteur         'ObjetLecteurDeDisque
Dim oRepertoire      'ObjetRépertoire
Dim oFS              'ObjetFileSystem (Objet du système de fichier)
Dim sOutput          'Variable d'écriture
Dim oInfoLecteur     'Variable d'information sur le lecteur courant
Dim oInfoFichier     'Variable d'information sur le fichier courant
Dim Lecteur          'Variable du lecteur à lire
Dim Disque           'Variable du lecteur à écrire
Dim Fichier          'Variable du fichier de sortie
Dim Flag             'Drapeau (logique)
Dim msgTexte         'Variable de message è l'usager
Dim lngTexte         'Variable de la longueur d'une chaine de caractères
Dim Dossier          'Variable chaine du dossier de départ
Dim DonneesValide    'Variable de la valeur des saisies
'
'(Ligne 45)====================================================================================
'
' Déclaration des variables globales du classeur EXCEL
'
Dim xlApp, xlBook, xlChart, xlRange     'Objets classeur
Dim xlWhs, iRows, iCols, iRotate        'Objets feuille
'
'(Ligne 52)====================================================================================
' Debut du programme
'
'Sub Main()' (Attention, le label n'exite pas en VBS)

    DonneesValide = CaptureEntree(Fichier,Lecteur,Dossier)
    If ( DonneesValide ) Then
        ' Création de l'objet Excel (une classe)
        Set oFS = CreateObject("Scripting.FileSystemObject")
        Set xlApp = CreateObject("Excel.Application")
        ' Vérification de la présence du classeur
        If (FichierExistant(Fichier) = True) Then
            ' Ouverture du classeur
            Set xlBook = xlApp.Workbooks.Open(Fichier)
            Flag = True
        Else
            ' Création du classeur
            xlApp.SheetsInNewWorkbook = 1
            Set xlBook = xlApp.Workbooks.Add
        End If
        ' Positionnement à l'intérieur du classeur
        Set xlWKS = xlBook.Worksheets(1)
        Set xlRange = xlWKS.Range("A1:A65535")
        ' Capture de la lettre du lecteur à écrire
        Disque = Mid(Fichier, 1, 2)
        Set oLecteur = oFS.GetDrive(Disque)
        If (oLecteur.IsReady) Then
            ' Capture de la lettre du lecteur à lire
            Set oLecteur = oFS.GetDrive(Lecteur)
            If (oLecteur.IsReady) Then
                Call Principal(Fichier)
            Else
                EnvoiMessage (0)
            End If
        Else
            EnvoiMessage (0)
        End If
    End if
'
'End Sub (Le label n'exite pas en VBS) Fin de Programme
'
'(Ligne 93)====================================================================================
'
Function CaptureEntree(ByRef FichierCE, ByRef LecteurCE, ByRef DossierCE) 

    On Error Resume next
    Flag = False
    
    FichierCE = ""
    msgTexte = msgTexte & "Attention!" & vbCrLf & vbCrLf
    msgTexte = msgTexte & "Le programme ne gère pas les erreurs!" & vbCrLf & vbCrLf & vbCrLf
    msgTexte = "Entrez le nom du fichier : " & vbCrLf & "(ex.: C:\Infofile.xls)"
    FichierCE = InputBox(msgTexte, "Saisie du fichier à créer", "C:\Info.xls")

    If ( len(FichierCE) >  7 ) Then
        LecteurCE = ""
        LecteurCE = InputBox("Entrez la lettre du lecteur à lire :", "Saisie du lecteur à lire", "C")
        If ( Len(LecteurCE) = 1 ) Then
            DossierCE = ""
            DossierCE = InputBox("Entrez le dossier cible du lecteur à lire :", "Saisie du dossier à lire", "\TEMP")
            If ( len(DossierCE) > 1 ) Then
                CaptureEntree = True
            Else
                DossierCE = ""
                CaptureEntree = true
            End If
        Else
            CaptureEntree = False
	End If
    Else
        CaptureEntree = False
    End if

End Function
'
'(Ligne 127)===================================================================================
'
Sub Principal(ByVal NomFichier)

    Dim Plage
    Dim Valeur
    Dim Boucle
    
    On Error Resume Next
    ' Création de l'En-tête du fichier Excel    
    Call CreationEnTete
    'Placement d'Excel en arrière plan!
    xlApp.WindowState = xlMinimized
    xlApp.ScreenUpdating = False
    
    If (oLecteur.IsReady) Then
        If (Dossier <> "") Then
            'cteLecture à partir du sous-répertoire cible
            Set oRepertoire = oFS.GetFolder(Lecteur & ":" & Dossier)
            xlApp.Visible = True
            xlWKS.Activate
            xlRange.Cells(1, 1).Select
            Call ListeFichier(oRepertoire) ' Routine récursive
        Else
            'cteLecture des fichiers dans la racine du lecteur
            If (oLecteur.RootFolder.Files.Count > 0) Then
                For Each oFichier In oLecteur.RootFolder.Files
                    InsertionDonnees (oFichier)
                Next
            End If
        
            'cteLecture des sous-répertoires dans le lecteur
            For Each oRepertoire In oLecteur.RootFolder.SubFolders
                xlApp.Visible = True
                xlWKS.Activate
                xlRange.Cells(1, 1).Select
                Call ListeFichier(oRepertoire) ' Routine récursive
            Next
        End If
    End If
    MiseEnforme
    'Placement d'Excel en avant plan!
    xlApp.ScreenUpdating = True
    xlApp.WindowState = xlMaximized
    xlRange.Columns("A:A").EntireColumn.AutoFit
    xlRange.Columns("E:G").EntireColumn.AutoFit

    
    'Fermeture du fichier Excel
    Call FermetureExcel()
    wscript.echo "Fin de traitement :-) "

End Sub
'
'(Ligne 178)===================================================================================
'
Function FichierExistant(NomFichier)

    Dim fso

    Set fso = CreateObject("Scripting.FileSystemObject")
    FichierExistant = fso.FileExists(NomFichier)
    Set fso = Nothing

End Function
'
'(Ligne 190)===================================================================================
'
Function EnvoiMessage(ByVal Chiffre)

    Select Case Chiffre
        Case 0:  msgTexte = "Lecteur non disponible !"
        Case 1:  msgTexte = "Disponible !"
        Case 2:  msgTexte = "Disponible !"
        Case 3:  msgTexte = "Disponible !"
        Case 4:  msgTexte = "Disponible !"
        Case 5:  msgTexte = "Disponible !"
        Case 6:  msgTexte = "Disponible !"
        Case Else:       msgTexte = "Code d'erreur inexistant !"
    End Select
                        
    Wscript.Echo msgTexte

End Function
'
'(Ligne 209)===================================================================================
'
Sub ListeFichier(ByVal oRepertoire)    ' Routine récursive

    Dim oDossier

    On Error Resume Next

    If (oRepertoire.Files.Count > 0) Then
        For Each oFichier In oRepertoire.Files
            InsertionDonnees (oFichier)
        Next
    End If

    If (oRepertoire.SubFolders.Count > 0) Then
        For Each oDossier In oRepertoire.SubFolders
            Call ListeFichier(oDossier)
        Next
    End If
        
End Sub
'
'(Ligne 231)===================================================================================
'
Function ChercheAttributs(ByVal oFichier, ByVal Validation, ByRef Repons)

    On Error Resume Next

    Repons = "Aucun"

    Select Case (Validation)
        Case (cteLecture):
            If (oFichier.Attributes And 1) Then
                Repons = "Activer" 'Read-only = VRAI
            Else
                Repons = "Désactiver" 'Read-only = FAUX
            End If

        Case (cteCache):
            If (oFichier.Attributes And 2) Then
                Repons = "Activer" 'Hidden file = VRAI
            Else
                Repons = "Désactiver" 'Hidden file = FAUX
            End If

        Case (cteSysteme):
            If (oFichier.Attributes And 4) Then
                Repons = "Activer" 'System file = VRAI
            Else 
                Repons = "Désactiver" 'System file = FAUX
            End If

        Case (cteArchive):
            If (oFichier.Attributes And 32) Then 
                Repons = "Activer" 'cteArchive bit = VRAI
            Else 
                Repons = "Désactiver" 'cteArchive bit = FAUX
            End If

        Case (cteRaccourci):
            If (oFichier.Attributes And 64) Then 
                Repons = "Activer" 'ShortCut = VRAI
            Else 
                Repons = "Désactiver" 'ShortCut = FAUX
            End If

        Case (cteCompresse):
            If (oFichier.Attributes And 2048) Then 
                Repons = "Activer" 'cteCompressed file = VRAI
            Else 
                Repons = "Désactiver" 'cteCompressed file = FAUX
            End If

        Case Else: Repons = "Aucun"
    
    End Select

End Function
'
'(Ligne 288)===================================================================================
'
Function CreationEnTete()

    Dim Valeur
    Dim Boucle
    
    On Error Resume Next
    
    If (Flag = False) Then
        'Création de l'en-tête du fichier EXCEL
        xlRange.Cells(1, 1).Value = "Nom Fichier"
        xlRange.Cells(1, 2).Value = "Type Fichier"
        xlRange.Cells(1, 3).Value = "Grandeur"
        xlRange.Cells(1, 4).Value = "Chemin d'accès"
        xlRange.Cells(1, 5).Value = "Date Créé"
        xlRange.Cells(1, 6).Value = "Date Accédé"
        xlRange.Cells(1, 7).Value = "Date Modifié"
        xlRange.Cells(1, 8).Value = "Nom cours"
        xlRange.Cells(1, 9).Value = "Chemin cours"
        xlRange.Cells(1, 10).Value = "Version"
        xlRange.Cells(1, 11).Value = "Attr Caché"
        xlRange.Cells(1, 12).Value = "Attr Système"
        xlRange.Cells(1, 13).Value = "Attr Archive"
        xlRange.Cells(1, 14).Value = "Attr Lecture seule"
        xlRange.Cells(1, 15).Value = "Attr Raccourci"
        xlRange.Cells(1, 16).Value = "Attr compressé"
        ' Dans Sub MiseEnForme la plage est ("A1:P1")
        ' Défini par la constante ctePlgFitGlobale
        iRows = 2
    Else
        Boucle = 1
        Valeur = xlRange.Cells(1, 1).Value
        While (Valeur <> "")
            Boucle = (Boucle + 1)
            Valeur = xlRange(Boucle, 1)
        Wend
        iRows = Boucle
    End If

End Function
'
'(Ligne 330)===================================================================================
'
Function MiseEnForme()

    xlRange.Columns(ctePlgFitGlobale).EntireColumn.AutoFit
    xlRange("A2").Select

End Function
'
'(Ligne 339)===================================================================================
'
Function InsertionDonnees(ByVal CeFichier)

    On Error Resume Next

    Dim Reponse
                    
    xlRange.Cells(iRows, 1).Value = CeFichier.Name
    xlRange.Cells(iRows, 2).Value = CeFichier.Type
    xlRange.Cells(iRows, 3).Value = CeFichier.Size
    xlRange.Cells(iRows, 4).Value = CeFichier.Path
    xlRange.Cells(iRows, 5).Value = CeFichier.DateCreated
    xlRange.Cells(iRows, 6).Value = CeFichier.DateLastAccessed
    xlRange.Cells(iRows, 7).Value = CeFichier.DateLastModified
    xlRange.Cells(iRows, 8).Value = CeFichier.ShortName
    xlRange.Cells(iRows, 9).Value = CeFichier.ShortPath
    xlRange.Cells(iRows, 10).Value = ChercheVersion(CeFichier.Name)
            
    Call ChercheAttributs(CeFichier, cteCache, Reponse)
    xlRange.Cells(iRows, 11).Value = Reponse
    Call ChercheAttributs(CeFichier, cteSysteme, Reponse)
    xlRange.Cells(iRows, 12).Value = Reponse
    Call ChercheAttributs(CeFichier, cteArchive, Reponse)
    xlRange.Cells(iRows, 13).Value = Reponse
    Call ChercheAttributs(CeFichier, cteLecture, Reponse)
    xlRange.Cells(iRows, 14).Value = Reponse
    Call ChercheAttributs(CeFichier, cteRaccourci, Reponse)
    xlRange.Cells(iRows, 15).Value = Reponse
    Call ChercheAttributs(CeFichier, cteCompresse, Reponse)
    xlRange.Cells(iRows, 16).Value = Reponse

    iRows = (iRows + 1)
    If (iRows > 65534) Then
        xlApp.ActiveWorkbook.Worksheets.Add
        Set xlWKS = xlBook.Worksheets(1)
        Set xlRange = xlWKS.Range("A1:A65535")
        iRows = 2
    End If

End Function
'
'(Ligne 381)===================================================================================
'
Function FermetureExcel()

    xlApp.Visible = True
    xlWKS.Activate
    xlRange.Cells(1, 1).Select
    xlApp.DisplayAlerts = False
    xlBook.SaveAs Fichier
    xlApp.Quit
    xlApp.DisplayAlerts = True

    Set xlRange = Nothing
    Set xlChart = Nothing
    Set xlWKS = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
    iRows = 0
    iCols = 0

End Function


    Lupin
    5
  2. btissam2 Messages postés 22 Statut Membre 4
     
    salut khouloude
    pour la forme circulaire ou carré je pense que dans la barre d'outil il y a un objet qui peut te sérvir c "shape"
    a+
    3
  4. gbinforme Messages postés 14930 Date d'inscription   Statut Contributeur Dernière intervention   4 744
     
    bonjour

    c'est tout à fait possible en visual basic VBA.

    c'est un langage de programmation qu'il faut apprendre
    mais on peut le découvrir en enregistrant des macros
    et en utilisant l'aide et les exemples.

    1

  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. gbinforme Messages postés 14930 Date d'inscription   Statut Contributeur Dernière intervention   4 744
     
    bonjour

    en plus j'ai pas compris comment les macros vont résoudre mon probleme.

    il faudrait peut-être que tu précis ton problème,
    car pour ajouter des variables dans les cellules c'est possible avec VBA
    mais apparement c'est autre chose que tu veux.

    1
  7. random Messages postés 1612 Statut Membre 155
     
    essaye ca
    Dim x As New Excel.Application
    Workbooks.Open FileName:="C:\mondossier.xls"
    /* ici tu mets à la place de d10 ta colonne et ta ligne"
    /* éventuellement sous la forme variable1 & variable2
    Sheets("ma feuille").Select

    /* ici tu mets à la place de d10 ta colonne et ta ligne"
    /* éventuellement sous la forme variable1 & variable2
    Range("C3").Select
    ActiveCell.FormulaR1C1 = "salut ma poule"
    /* tu templace salut ma poule par moncontrole.text
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    Set x = Nothing
    1
  8. random Messages postés 1612 Statut Membre 155
     
    'ai oublié pour que ca fonctionne il faut faire
    projet
    référence et cocher microsoftexcel
    1
  9. rol
     
    comment creer un logiciel
    1
    1. -Shadow-
       
      quelle question... il faut se connaître en programmation...
      0
  10. khouloud
     
    bonjour,
    j'ai essayer de creer des macros Vb sur excel mais je n'arrive pas a touver le code pour y ecrire dans le module ouvert.
    en plus j'ai pas compris comment les macros vont résoudre mon probleme.
    merci de me répondre.
    j'en ai tres besoin :)
    -1
  11. khouloud
     
    Bonjour,
    je développe un application avec VB6.0;
    mon probléme c'est que aprés l'exécution et lorsque je clique sur arréter le programme parcours tous les pages pour s'arreter
    (dans mon pg j'ai 32 form).

    svp aider moi,
    merci d'avance.
    0
  12. khouloud
     
    Merci bqqqqq,
    je garderais ton algo,mais j'ai creer des procedure de calcul dans mon programme parceque j'ai vu que c'est plus joli que d'ouvrir une page d'excel.

    encore merciiiiiiiiiiii Random
    0
  13. khouloud
     
    bonjour,
    est ce que tu sais comment ajouter une barre d'outils dans VB 6.0 qui contient des forme cerculaire ou bien carre parcaque je doit faire une page qui contient une carte avec plusieurs cercle comme dans powerpoint par exp.
    0
  14. diop
     
    aider moi je plus nul et je voudrais pouvoir programmer avec vb et excel, je sui comptable j'en besoin de l'aide pleace
    0
    1. diop
       
      comment utiliser mes macro?
      0
  15. khouloud
     
    j'ai pas compris votre probleme, il faut la préciser
    0
  16. AZOULA
     
    Suis intéressé par programme VB qui pilote Excel. Merci pour Cop.
    0
  18. khouloud
     
    Bonjour

    merci bien,

    je crois que j'ai trouvé la solution.

    par contre comme je suis débutante en Vb ,j'essye de creer une petite application qui tourne et j'aimerais savoir:
    lorsque j'arrete l'execution, le programme ne se ferme pas directement mais il reste en attente jusqu'a ce qu'il ferme toutes les feuilles, alors comment pourrais-je le fermer toutes suit comme tous autre logiciel lorsque tu clique sur fermer il se ferme.

    merci beaucoup.
    -1

Discussions similaires

Problème scanner HP Deskjet 2320
manineVLB -
manineVLB -

3 réponses