Programme Vb qui pilote excel [Résolu]

gbinforme, le mercredi 6 avril 2005 à 09:01:57

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.

toujours zen

Répondre à gbinforme

2

khouloud, le mercredi 6 avril 2005 à 12:12:31

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

Répondre à khouloud

3

gbinforme, le mercredi 6 avril 2005 à 18:36:20

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.

toujours zen

Répondre à gbinforme

4

Lupin.Arsene, le jeudi 7 avril 2005 à 00:46:08

+1

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
~L'essentiel est invisible pour les yeux~
~On ne voit bien qu'avec le coeur~

Répondre à Lupin.Arsene

5

khouloud, le jeudi 7 avril 2005 à 10:16:18

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.

Répondre à khouloud

6

khouloud, le jeudi 14 avril 2005 à 12:46:45

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.

Répondre à khouloud

7

random, le jeudi 14 avril 2005 à 14:53:36

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 elle est pas belle, la vie ?

Répondre à random

8

random, le jeudi 14 avril 2005 à 15:14:57

'ai oublié pour que ca fonctionne il faut faire
projet
référence et cocher microsoftexcel elle est pas belle, la vie ?

Répondre à random

9

khouloud, le jeudi 14 avril 2005 à 16:22:59

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

Répondre à khouloud

10

khouloud, le vendredi 15 avril 2005 à 10:47:32

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.

Répondre à khouloud

11

diop, le vendredi 15 avril 2005 à 13:38:08

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

Répondre à diop

13

diop, le vendredi 15 avril 2005 à 17:28:29

Comment utiliser mes macro?

Répondre à diop

12

khouloud, le vendredi 15 avril 2005 à 14:06:56

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

Répondre à khouloud

14

btissam2, le mardi 26 avril 2005 à 22:06:36

+1

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+

Répondre à btissam2

15

AZOULA, le mercredi 12 septembre 2007 à 19:20:55

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

Répondre à AZOULA

16

Rachris, le mardi 29 janvier 2008 à 09:04:57

Donnez mois un exemple

Répondre à Rachris

17

Lupin.A, le mardi 29 janvier 2008 à 13:00:33

+3

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

Répondre à Lupin.A

18

rol, le samedi 19 avril 2008 à 18:22:17

Comment creer un logiciel

Répondre à rol

19

-Shadow-, le dimanche 20 avril 2008 à 20:39:54

+2

Quelle question... il faut se connaître en programmation... explorer.exe a cessé de vivre

Répondre à -Shadow-