programme Vb qui pilote excel Résolu

Question

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.

Utilisateur anonyme · Accepted Answer

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

gbinforme · Answer

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.

khouloud · Answer

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 :)

gbinforme · Answer

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.

Utilisateur anonyme · Answer

Bonjour,suggestion :voici un exemple VBS importable facilement sous VBcette exemple pilote excel de l'extérieur.http://www.oricom.ca/lupin/document/excelvbs.txtLupin

khouloud · Answer

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.

khouloud · Answer

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.

random · Answer

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

random · Answer

'ai oublié pour que ca fonctionne il faut faireprojetréférence et cocher microsoftexcel

khouloud · Answer

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

khouloud · Answer

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.

diop · Answer

aider moi je plus nul et je voudrais pouvoir programmer avec vb et excel, je sui comptable j'en besoin de l'aide pleace

khouloud · Answer

j'ai pas compris votre probleme, il faut la préciser

btissam2 · Answer

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+

AZOULA · Answer

Suis intéressé par programme VB qui pilote Excel. Merci pour Cop.

Rachris · Answer

Donnez mois un exemple

rol · Answer

comment creer un logiciel

Programme Vb qui pilote excel

17 réponses

Votre réponse

Newsletters