none
Plantage d'Excel sur instruction d'écriture dans le module "ThisWorkbook" d'un autre fichier RRS feed

  • Question

  • Bonjour à tous,

    J'essaye de copier (automatiquement) un module dans le module ThisWorkbook d'un autre fichier

        'Copie macro dans variable texte
        strCode = WorkbookInput.VBProject.VBComponents.Item(TOOL_MODULE_TO_EXPORT).CodeModule.Lines(1, WorkbookTool.VBProject.VBComponents.Item(TOOL_MODULE_TO_EXPORT).CodeModule.CountOfLines)
        'coller le texte dans le module destination
        toto = WorkbookOutput.VBProject.VBComponents("ThisWorkbook").CodeModule.InsertLines(1, strCode)

    Excel plante (et envoye un rapport d'erreur à Mircrosoft) lors de l'écriture. Si j'écris dans un autre module, pas de problème.

    Le code que je met dans le module ThisWorkbook a une action sur Workbook_SheetChange.

    J'ai activé l'option "Faire confiance au projet Visual Basic"

    D'où viens le problème?

    - Je ne suis pas admin de la machine et il y a une protection qui saute?

    - L'évenement Workbook_SheetChange est levé au milieu de la copie?

    Merci de vos idées.

    mercredi 14 mars 2012 16:43

Réponses

  • Oui, évidement, deux fichiers seont présents, mais non en fait...

    Le but consiste à faire ensorte qu'un certain nombre de routines soit disposnible pour appliquer une certaine mise en forme à un jeu de données.

    Pour obtenir ces données, quelles que'elles soient, (CSV, TXT, MDB, TextStream...) il suffit d'ouvrir et lire le contenu et de faire en sorte que le nouveau classeur reçoive ces données :

    • Donc l'événement Open/New  (selon le cas) se déclenche à l'ouverture du modèle.
    • De cet événement, on déclenche l'ouverture du CSV (procédure private au sein du modèle)...
    • On manipule les données comme il se doit
    • On copie le tout dans ce nouveau classeur (celui fondé sur le modèle qui est en cours d'utilisation - on est toujours dans l'événement appelant Open)
    • On sauve au format voulu - on sort de la procédure du CSV
    • On referme le CSV sans sauver
    • C'est fini...

    Bon certes, il faut manipuler du code avec des objets Excel...

    J'ai suffisamment d'heures de vol  sous Excel pour vous confirmer que cela fonctionne...


    Argy

    • Marqué comme réponse Riri_bzh jeudi 31 mai 2012 11:08
    lundi 14 mai 2012 06:51
    Modérateur

Toutes les réponses

  • Bonjour,

    TOOL_MODULE_TO_EXPORT est une variable ou bien un nom ?

    Si c'est le nom du module il faut écrire :

    ...VBComponents.Item("TOOL_MODULE_TO_EXPORT")

    Si c'est le N°, l'item de VBProject commence par 1 et non par 0 comme pour les autres collections.

    Cordialement,


    Visitez mes sites : http://2gm.free.fr | http://loufab.developpez.com

    vendredi 16 mars 2012 15:18
  • Bonjour,

    C'est une constante string pour la généricité du code.

    C'est pas ça...

    Merci

    Cordialement,

    Riwal

    lundi 19 mars 2012 11:57
  • Bonjour,

    Pourquoi l'instruction comporte t-elle deux objets Workbook distincts ? (WorkbookInput et WorkbookTool).

    Quel est la suite du code (utile pour vous aider...) ?


    Argy

    jeudi 29 mars 2012 10:42
    Modérateur
  • Peut être est-il intéressant et plus simple dans le cadre d'une copie conforme du module d'utiliser la méthode Export?

    " VBComponents.Item("Index").Export (filename) "

    Je vous laisse le soin de tester avec votre exemple.

    Cordialement

    Fabien

    vendredi 30 mars 2012 09:41
  • Bonjour,

    Mes essais montre qu'il est impossible d'importer le module(en .bas ou en .cls) dans "ThisWorkbook".

    La fonction Import ne fonctionne que sur "VBComponents." et crée un nouveau module appellé "ThisWorkbook1" !

    Bien essayé!

    Cordialement,

    Riwal

    • Modifié Riri_bzh mardi 3 avril 2012 08:57
    mardi 3 avril 2012 08:54
  • Bonjour Argy,

    Je crée un outil VBA dont l'interface graphique est Excel (pour me faciliter le travail) qui:

    - Ouvre un fichier csv et le sauvegarde en xls

    - Fait de la mise en forme sur ce nouveau fichier (couleurs des cellules, titres en gras, ajout de colonnes avec Validation de donnée, ....)

    - Ajoute une macro dans ThisWorkbook pour qu'à chaque modification de chaque feuille, un traitement de controle et de mise en cours soit fait.

    Voici ma fonction qui fait se traitement:

    Const TOOL_WORKBOOK_FILE_CSV As String = "C7"
    Const TOOL_MODULE_TO_EXPORT As String = "ModuleAExporter"
    Const VBA_MAIN_MODULE As String = "ThisWorkbook"

    'Columns to add in the sheet
    Const CR_COLUMN_TO_ADD_NB As Integer = 8
    Const CR_COLUMN_TO_ADD_1 As String = "Analyse"
    Const CR_COLUMN_TO_ADD_2 As String = "Commentaire"
    Const CR_COLUMN_TO_ADD_3 As String = "Equipe"
    Const CR_COLUMN_TO_ADD_4 As String = "C"
    Const CR_COLUMN_TO_ADD_5 As String = "M"
    Const CR_COLUMN_TO_ADD_6 As String = "S"
    Const CR_COLUMN_TO_ADD_7 As String = "Réponse"
    Const CR_COLUMN_TO_ADD_8 As String = "Etat"

    'Chaines de validation
    Const STRING_ERREUR_OUTIL As String = "erreur outil"
    Const STRING_NA As String = "n/a"
    Const STRING_KO As String = "ko"
    Const STRING_EQUIPE_GCM As String = "GCM"
    Const STRING_EQUIPE_CL As String = "CL"
    Const STRING_VIDE As String = ""
    Const STRING_ACCEPT As String = "A"
    Const STRING_REFU As String = "R"
    Const STRING_FAIT As String = "F"
    Const STRING_CONTROLE As String = " -"


    Private Sub PrepareButton_Click()
        'Data needed
        'CSV File data
        Dim PathCSV As String
        Dim PathTxt As String
        Dim PathXls As String
        Dim BookNameCSV As String
        Dim BookNameTxt As String
        Dim BookNameXls As String
        Dim SheetNameInput As String
        
        'Range of CR sheet
        Dim Last_Header_Row As Integer
        Dim First_Table_Row As Integer
        Dim Last_Table_Row As Integer
        Dim First_Table_Column As Integer
        Dim Last_Table_Column  As Integer
        
        'temp data
        Dim Tableau() As String
        Dim strCode As String 'Code de macro à copier
        
        'Save link to actual file (that contain macro to export)
        Set WorkbookTool = ActiveWorkbook
        
        '************************* open file needeed and save as XLS ********************************************************
        PathCSV = ActiveSheet.Range(TOOL_WORKBOOK_FILE_CSV).Text 'Original name for convertion to xls
        Tableau = Split(PathCSV, "\")
        BookNameCSV = Tableau(UBound(Tableau, 1))
        SheetNameInput = Left(Left(BookNameCSV, Len(BookNameCSV) - 4), 31) 'Name of the sheet( file - ".csv") limited to 31 chars
        
        PathTxt = Left(PathCSV, Len(PathCSV) - 4) + ".txt" 'Temporary name for convertion to xls
        Tableau = Split(PathTxt, "\")
        BookNameTxt = Tableau(UBound(Tableau, 1))
        PathXls = Left(PathCSV, Len(PathCSV) - 4) + ".xls" 'Final name for convertion to xls
        Tableau = Split(PathXls, "\")
        BookNameXls = Tableau(UBound(Tableau, 1))

        On Error GoTo ErrorHandler
            'Renomé en .txt pour ouvrir avec les séparateur ";". Au US, le séparateur est le ","
            FileCopy PathCSV, PathTxt
        On Error Resume Next
            'Ouvrir Txt => bonne prise en compte des séparateurs ";" sur PC en FR
            toto = Workbooks.Open(PathTxt, Format:=4)
        On Error GoTo 0
        'Enregistrement en XLS
        Application.DisplayAlerts = False
        Workbooks(BookNameTxt).SaveAs Filename:=PathXls, FileFormat:=xlExcel9795
        Application.DisplayAlerts = True
        'Supprimer fichier txt
        Kill PathTxt
        
        'Maintenant, utilisation du XLS
        Set WorkbookInput = Workbooks(BookNameXls)
        '************************* Mise en forme du fichier target ********************************************************
        Set WorkingSheet = WorkbookInput.Sheets(SheetNameInput)
        
        'Range of header
        Last_Header_Row = WorkingSheet.Range("A1").CurrentRegion.Rows(WorkingSheet.Range("A1").CurrentRegion.Rows.Count).Row
        
        'Range of table
        With WorkingSheet.Cells(Last_Header_Row + 2, 1).CurrentRegion
            First_Table_Row = .Rows(1).Row
            Last_Table_Row = .Rows(.Rows.Count).Row
            First_Table_Column = .Columns(1).Column
            Last_Table_Column = .Columns(.Columns.Count).Column
        End With
        
        'Add new columns
        WorkingSheet.Cells(First_Table_Row, Last_Table_Column + 1).Value = CR_COLUMN_TO_ADD_1
        WorkingSheet.Cells(First_Table_Row, Last_Table_Column + 2).Value = CR_COLUMN_TO_ADD_2
        WorkingSheet.Cells(First_Table_Row, Last_Table_Column + 3).Value = CR_COLUMN_TO_ADD_3
        WorkingSheet.Cells(First_Table_Row, Last_Table_Column + 4).Value = CR_COLUMN_TO_ADD_4
        WorkingSheet.Cells(First_Table_Row, Last_Table_Column + 5).Value = CR_COLUMN_TO_ADD_5
        WorkingSheet.Cells(First_Table_Row, Last_Table_Column + 6).Value = CR_COLUMN_TO_ADD_6
        WorkingSheet.Cells(First_Table_Row, Last_Table_Column + 7).Value = CR_COLUMN_TO_ADD_7
        WorkingSheet.Cells(First_Table_Row, Last_Table_Column + 8).Value = CR_COLUMN_TO_ADD_8

        'Definir les choix imposés
        'Colonne Analyse :
        With WorkingSheet.Columns(Last_Table_Column + 1).Validation
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=STRING_ERREUR_OUTIL + "," + STRING_NA + "," + STRING_KO
            .IgnoreBlank = True
            .InCellDropdown = True
        End With
        'Colonne Equipe :
        With WorkingSheet.Columns(Last_Table_Column + 3).Validation
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=STRING_EQUIPE_GCM + "," + STRING_EQUIPE_CL
            .IgnoreBlank = True
            .InCellDropdown = True
        End With
        'Colonne C :
        With WorkingSheet.Columns(Last_Table_Column + 4).Validation
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:="X, "
            .IgnoreBlank = True
            .InCellDropdown = True
        End With
        'Colonne M :
        With WorkingSheet.Columns(Last_Table_Column + 5).Validation
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:="M, "
            .IgnoreBlank = True
            .InCellDropdown = True
        End With
        'Colonne S :
        With WorkingSheet.Columns(Last_Table_Column + 6).Validation
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=STRING_REFU + "," + STRING_FAIT + "," + STRING_CONTROLE
            .IgnoreBlank = True
            .InCellDropdown = True
        End With
        'Colonne Etat :
        With WorkingSheet.Columns(Last_Table_Column + 8).Validation
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=STRING_FAIT + "," + STRING_CONTROLE
            .IgnoreBlank = True
            .InCellDropdown = True
        End With


        Last_Table_Column = Last_Table_Column + 8
        
        'Jaune (seulement 1ere ligne)
        WorkingSheet.Range(WorkingSheet.Cells(First_Table_Row, First_Table_Column), WorkingSheet.Cells(First_Table_Row, Last_Table_Column)).Interior.ColorIndex = 6 'Yellow
        WorkingSheet.Range(WorkingSheet.Cells(First_Table_Row, First_Table_Column), WorkingSheet.Cells(First_Table_Row, Last_Table_Column)).Font.Bold = True
        
        'Largeur des colonnes
        'on commence à B car A n'a pas besoin (dans le format actuel)
        WorkingSheet.Columns("B:" + Chr(65 + Last_Table_Column)).EntireColumn.AutoFit
        For Each actualColumn In WorkingSheet.Columns
            'limiter la largeur à 25 (sinon c'est trop grand)
            If actualColumn.ColumnWidth > 25 Then
                actualColumn.ColumnWidth = 25
            End If
            'a faire seulement sur les colonnes actives
            If actualColumn.Column > Last_Table_Column Then
                Exit For
            End If
        Next

        'Define TableRange
        Set WorkTableRange = WorkingSheet.Range(WorkingSheet.Cells(First_Table_Row, First_Table_Column), WorkingSheet.Cells(Last_Table_Row, Last_Table_Column))
        
        'bordures
        WorkTableRange.Borders(xlDiagonalDown).LineStyle = xlNone
        WorkTableRange.Borders(xlDiagonalUp).LineStyle = xlNone
        With WorkTableRange.Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With WorkTableRange.Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With WorkTableRange.Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With WorkTableRange.Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With WorkTableRange.Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        With WorkTableRange.Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlThin
            .ColorIndex = xlAutomatic
        End With
        
        'Ajouter le filtre automatique
        WorkTableRange.AutoFilter
        
        '************************* copy macro in target file ********************************************************

        'Copie macro dans variable texte
    '*************************
    'TODO RLC : Mettre les 1ere constantes auto-ajusté et les Chaines de validation forcés
    '*************************
        'strCode = WorkbookTool.VBProject.VBComponents.Item(TOOL_MODULE_TO_EXPORT).CodeModule.Lines(1, WorkbookTool.VBProject.VBComponents.Item(TOOL_MODULE_TO_EXPORT).CodeModule.CountOfLines)
        'coller le text dans le module destination
        'toto = WorkbookInput.VBProject.VBComponents(VBA_MAIN_MODULE).CodeModule.InsertLines(1, strCode)

        
        'Sauvegarde finale
        WorkbookInput.Save
    Exit Sub

    ErrorHandler:
        MsgBox ("Error during file openning")
        Application.StatusBar = False
        
    End Sub


    Voici le code que je veux envoyer dans le module ThisWorkbook du nouveau fichier:

    Const COLUMN_MIN As Integer = 1
    Const COLUMN_ANALYSE As Integer = 11
    Const COLUMN_S As Integer = 16
    Const COLUMN_REPONSE As Integer = 17
    Const COLUMN_ETAT As Integer = 18
    Const COLUMN_MAX As Integer = 18
    Const LINE_TITLE As Integer = 9

    Const STRING_ERREUR_OUTIL As String = "erreur outil"
    Const STRING_NA As String = "n/a"
    Const STRING_KO As String = "ko"
    Const STRING_VIDE As String = ""
    Const STRING_ACCEPT As String = "A"
    Const STRING_REFU As String = "R"
    Const STRING_FAIT As String = "F"
    Const STRING_CONTROLE As String = " -"

    Const COLOR_WHITE As Integer = 0
    Const COLOR_RED As Integer = 3
    Const COLOR_BLUE As Integer = 41
    Const COLOR_GREEN As Integer = 43

    'Change : 1 changement dans une feuille
    Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

        Static Semaphore As Boolean
        
        Dim LineImpacted As Integer
        
        If Not Semaphore Then
            Semaphore = True
            
            Set WorkingSheet = ActiveSheet
            'Récupération du numéro de la ligne à traiter (Si 1 seule ligne)
            If Target.Rows.Count = 1 Then
                LineImpacted = Target.Rows(0).Row + 1
            End If
            'Si avant le tableau: pas d'action
            If LineImpacted <= LINE_TITLE Then
                Semaphore = False 'libère le sémaphore
                Exit Sub
            End If
            
            Set WorkingLineColor = WorkingSheet.Range(Cells(LineImpacted, COLUMN_MIN), Cells(LineImpacted, COLUMN_MAX)).Interior
               
            'check de la valeur "ANALYSE"
            If WorkingSheet.Cells(LineImpacted, COLUMN_ANALYSE).Value = STRING_ERREUR_OUTIL Then
                'On met en vert si l'analyse est une erreur outil
                WorkingLineColor.ColorIndex = COLOR_GREEN
                'On ajoute le symbole "-" dans les colonnes suivantes pas pas d'action complémentaire
                WorkingSheet.Cells(LineImpacted, COLUMN_S).Value = STRING_CONTROLE
                WorkingSheet.Cells(LineImpacted, COLUMN_REPONSE).Value = STRING_CONTROLE
                WorkingSheet.Cells(LineImpacted, COLUMN_ETAT).Value = STRING_CONTROLE
                  
            ElseIf WorkingSheet.Cells(LineImpacted, COLUMN_ANALYSE).Value = STRING_NA Then
                'Si l'analyse est Non applicable on met en blanc
                WorkingLineColor.ColorIndex = COLOR_WHITE
        
            ElseIf WorkingSheet.Cells(LineImpacted, COLUMN_ANALYSE).Value = STRING_KO Then
                'Si l'analyse est KO
                'On check la réponse "S"

                If WorkingSheet.Cells(LineImpacted, COLUMN_S).Value = STRING_ACCEPT Then
                    'Remarque acceptée
                    'On check la contre vérification "ETAT"
                    If WorkingSheet.Cells(LineImpacted, COLUMN_ETAT).Value = STRING_FAIT Then
                        'checker => bleu
                        WorkingLineColor.ColorIndex = COLOR_BLUE
                    Else
                        'pas checker (ou "-" à  la place de "F") => Rouge
                        WorkingLineColor.ColorIndex = COLOR_RED
                    End If
                ElseIf WorkingSheet.Cells(LineImpacted, COLUMN_S).Value = STRING_REFU Then
                    'Remarque rejetée
                    'On check la contre vérification "ETAT"
                    If WorkingSheet.Cells(LineImpacted, COLUMN_ETAT).Value = STRING_CONTROLE Then
                        'checker => bleu
                        WorkingLineColor.ColorIndex = COLOR_BLUE
                    Else
                        'pas checker (ou "F" à  la place de "-") => Rouge
                        WorkingLineColor.ColorIndex = COLOR_RED
                    End If
                Else
                    'Pas de encore réponse => Rouge
                    WorkingLineColor.ColorIndex = COLOR_RED
                End If 'On check la réponse "S"
            End If 'Si l'analyse est KO
            
            Semaphore = False
        End If 'Fin sémaphore
        
    End Sub
    'To launch for update all the table
    Public Sub Update_table()
        
        Dim Temp

        For Each ActiveRow In ActiveSheet.UsedRange.Rows
        'Pour chaque ligne
            Temp = ActiveRow.Cells(1, COLUMN_ANALYSE).Value
            'Provoque l'appel de la fonction principale
            ActiveRow.Cells(1, COLUMN_ANALYSE).Value = Temp
        Next
    End Sub


    Après execution en pas à pas et divers tests, mon problème est de "coller" mon code dans le nouveau fichier Excel.

    Le collage fonctionne vers une feuille ou un module mais pas dans le module "ThisWorkbook", c'est frustrant!

    Cordialement,

    Riwal


    • Modifié Riri_bzh mardi 3 avril 2012 09:15
    mardi 3 avril 2012 09:11
  • Bonjour,

    Je n'ai pas examiné le code faute de temps aujourd'hui mais de ce que vous évoquez, il me semble que votre besoin serait satisfait si vous basiez votre import CSV dans un XLT qui contient déjà tout le code dont vous avez besoin pour traiter le nettoyage et la mise en forme...

    Cela vous éviterait tous vos tracas et votre notion defaciliter la tâche sera accompli...

    Me trompé-je ?


    Argy

    mardi 3 avril 2012 14:51
    Modérateur
  • Bonjour Argy,

    L'examen du code sera surement une perte de temps, vous semblez bien avoir compris mon besoin.

    Je viens de faire quelques essais et rechercher un peu sur le web, mais je ne vois pas se que vous voulez dire par "import CSV dans un XLT". Je n'ai pas souvent utilisé des modeles. Pour moi, un modèle génére un document type vierge basé sur l'exemple (le modèle). Je ne sais pas comment ouvrir un CSV en appliquant un XLT dessus. Par contre, je vois bien que cela m'évitera de copier un macro d'un fichier à l'autre.

    Ca serais beaucoup plus propre que ce que je fait actuellement.


    Cordialement,

    Riwal
    mercredi 4 avril 2012 07:09
  • Eh le plus simplement du monde...

    Vous créez votre XLT ou xltm selon la version de votre Excel...

    Vous déposez ce code exemple dans l'événement Open de l'objet Workbook (et adaptez selon vos besoins biensûr)...

    Private Sub Workbook_Open()
        Dim strCSVFileName As String
        Dim lngErr As Long
        Dim strErr As String
    
        On Error GoTo Workbook_Open_Error
    
        MsgBox "Bienvenu dans le template d'import CSV...", 64, "Import CSV"
        strCSVFileName = Application.GetOpenFilename("CSV Files (*.csv), *.csv")
        If strCSVFileName <> False Then
            If ImportThisCSV(strCSVFileName, lngErr, strErr) = False Then
                Err.Raise lngErr, "Import CSV", strErr
            End If
        End If
    
        On Error GoTo 0
    Workbook_Open_Exit:
        Exit Sub
    Workbook_Open_Error:
        MsgBox "(" & lngErr & ") " & Err.Description, 48, Err.Source
        Resume Workbook_Open_Exit
    End Sub
    
    Private Function ImportThisCSV(ByVal CSVFilename As String, Optional ByRef ErrNum As Long, Optional ByRef ErrDesc As String) As Boolean
    
        On Error GoTo ImportThisCSV_Error
        '''' Routine de traitement du CSV
        '''' [...]
    
        ImportThisCSV = True
        On Error GoTo 0
    ImportThisCSV_Exit:
        Exit Function
    
    ImportThisCSV_Error:
        ImportThisCSV = False
        ErrNum = Err.Number
        ErrDesc = Err.Description
        Resume ImportThisCSV_Exit
    End Function
    

    Vous ouvrez alors le xlt (m) depuis l'Explorateur, et choisissez Nouveau ou New (ou par un autre processus)... et choisissez Ouvrir pour le modifier.


    Argy

    mercredi 4 avril 2012 08:07
    Modérateur
  • Re,

    Je crois comprend la manipulation, je ne l'ai pas encore essayé.

    Ce que vous proposer est d'avoir un template et de le populer avec les données du CSV en lisant le CSV manuellement.

    Je ne souhaite pas lire manuellement le CSV, Excel le fait tout seul (par une ouverture CSV puis sauvegarde en XLS) et la disposition dans les cellules me satisfait. Donc je ne souhaite pas avoir de fonction ImportThisCSV.

    Cdlt,

    Riwal
    mercredi 4 avril 2012 15:56
  • Humm, je pense que le fait de l'essayer vous permettra de comprendre...

    Le but n'est pas de faire du manuel ; c'est juste une démo pour vous montrer comment se comporte un XLT ouvert en tant que nouveau document :

    Fichier/Nouveau/A partir d'un document existant...

    En mode Prod, il est entendu que l’utilisateur final ouvrira un nouveau classeur Excel fondé sur ce modèle ; ce étant, il déclenche alors l'événement Open qui appelle une fonction pour aller chercher automatiquement le CSV et le traiter come vous l'avez prévu...

    C'est pourquoi je vous précisais qu'il vous appartient d'enrichir comme il se doit la fonction "ImportThisCSV" en gardant l'esprit de la gestion d'erreur qu'elle contient de manière à pouvoir l'intercepter dans l'événement appelant.


    Argy

    jeudi 5 avril 2012 06:39
    Modérateur
  • Bonjour,

    Je me suis mal exprimé en employant le mot "manuellement".

    Actuellement, pour "importer" mon fichier CSV (fichier lisible par Excel) j'utilise la fonction "Workbooks.Open()" de VBA, donc c'est au autre fichier Excel qui s'ouvre. On va le nommer GeneratedCSV.xls. (je le sauvegarde ensuite en xls avec  "Workbooks(xx).SaveAs FileFormat:=xlExcel9795" pour pouvoir ajouter la mise en forme et les macro.)

    Si je fais la même opération dans le XLT, la mise en forme présente dans le XLT vas s'appliqué à un nouveau fichier qui vas être créé (on va le nommer GeneratedXLT.xls), puis la méthode "Workbook_Open" vas être appelé qui va appeler la fonction "ImportThisCSV" qui va créer le fichier GeneratedCSV.xls sur lequel la mise en forme XLT ne s'appliquera pas.

    Je me retrouverais avec 2 fichiers : GeneratedCSV.xls avec les datas et GeneratedXLT.xls avec la mise en forme et les macros.

                            

    La méthode "Workbook_Open" du XLT  ne se substitue pas à la création du nouveau fichier XLS (essai fait)           

    J'en reviens donc à mon point de départ! (a moins de créer une fonction de lecture d'un CSV qui popule le xls)

    Cordialement


    • Modifié Riri_bzh vendredi 11 mai 2012 14:52
    vendredi 11 mai 2012 14:51
  • bonjour Riwal,
     
    une solution serait de lire la page et de reporter le texte lu vers la destination souhaité
     
    --
    isabelle
     
    Le 2012-05-11 10:51, Riri_bzh a écrit :
    > Bonjour,
    >
    > Je me suis mal exprimé en employant le mot "manuellement".
    >
    > Actuellement, pour "importer" mon fichier CSV (fichier lisible par Excel) j'utilise la fonction "**Workbooks.Open()**" de VBA, donc c'est au **autre **fichier Excel qui s'ouvre. On va le nommer */GeneratedCSV//.xls///*. (je le sauvegarde ensuite en xls avec "**Workbooks(xx).SaveAs FileFormat:=xlExcel9795**" pour pouvoir ajouter la mise en forme et les macro.)
    >
    > Si je fais la même opération dans le XLT, la mise en forme présente dans le XLT vas s'appliqué à un nouveau fichier qui vas être créé (on va le nommer /*/GeneratedXLT.xls/*/), puis la méthode "**Workbook_Open**" vas être appelé qui va appeler la fonction "**ImportThisCSV**" qui va créer le fichier */GeneratedCSV//.xls///* sur lequel la mise en forme XLT ne s'appliquera pas.
    >
    > Je me retrouverais avec 2 fichiers : */GeneratedCSV//.xls///* avec les datas et /*/GeneratedXLT.xls/*/ avec la mise en forme et les macros.
    >
    > La méthode "**Workbook_Open**" du XLT ne se substitue pas à la création du nouveau fichier XLS (essai fait)
    >
    > J'en reviens donc à mon point de départ! (a moins de créer une fonction de lecture d'un CSV qui popule le xls)
    >
    > Cordialement
    >
    >
     
    samedi 12 mai 2012 03:38
  • un exemple:
     
    Sub CopyCode()
    Dim S As String
       With Workbooks("PERSO.XLS").VBProject.VBComponents("Module6").CodeModule
        S = .Lines(1, .countoflines)
      End With
       With ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
        .AddFromString S
      End With
     
    End Sub
     --
    isabelle
     
    Le 2012-05-11 23:38, isabelleV a écrit :
    > bonjour Riwal,
    > une solution serait de lire la page et de reporter le texte lu vers la destination souhaité
    > --
    > isabelle
     
    samedi 12 mai 2012 04:18
  • as-tu ajouté les commandes,
    Application.EnableEvents = True
    Application.EnableEvents = False
    en debut et fin de macro ?
     
    --
    isabelle
     
    Le 2012-05-12 00:18, isabelleV a écrit :
    > un exemple:
    > Sub CopyCode()
    > Dim S As String
    > With Workbooks("PERSO.XLS").VBProject.VBComponents("Module6").CodeModule
    > S = .Lines(1, .countoflines)
    > End With
    > With ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
    > .AddFromString S
    > End With
    > End Sub
    > --
    > isabelle
    > Le 2012-05-11 23:38, isabelleV a écrit :
    >  > bonjour Riwal,
    >  > une solution serait de lire la page et de reporter le texte lu vers la destination souhaité
    >  > --
    >  > isabelle
     
    samedi 12 mai 2012 04:33
  • Oui, évidement, deux fichiers seont présents, mais non en fait...

    Le but consiste à faire ensorte qu'un certain nombre de routines soit disposnible pour appliquer une certaine mise en forme à un jeu de données.

    Pour obtenir ces données, quelles que'elles soient, (CSV, TXT, MDB, TextStream...) il suffit d'ouvrir et lire le contenu et de faire en sorte que le nouveau classeur reçoive ces données :

    • Donc l'événement Open/New  (selon le cas) se déclenche à l'ouverture du modèle.
    • De cet événement, on déclenche l'ouverture du CSV (procédure private au sein du modèle)...
    • On manipule les données comme il se doit
    • On copie le tout dans ce nouveau classeur (celui fondé sur le modèle qui est en cours d'utilisation - on est toujours dans l'événement appelant Open)
    • On sauve au format voulu - on sort de la procédure du CSV
    • On referme le CSV sans sauver
    • C'est fini...

    Bon certes, il faut manipuler du code avec des objets Excel...

    J'ai suffisamment d'heures de vol  sous Excel pour vous confirmer que cela fonctionne...


    Argy

    • Marqué comme réponse Riri_bzh jeudi 31 mai 2012 11:08
    lundi 14 mai 2012 06:51
    Modérateur
  • Bonjour Isabelle,

    Ces méthodes ne fonctionnent pas sur ("ThisWorkbook").

    Merci de votre aide.


    • Modifié Riri_bzh jeudi 31 mai 2012 11:12
    jeudi 31 mai 2012 11:04
  • Bonjour,


    En effet, j'ai pu finir mon outil grâce à un copier coller, mais je ne pense pas que ce soit le plus efficace(surtout sur les grands fichier).

    J'aurais comme même aimé une réponse sur la copie par VBA dans ("ThisWorkbook").

    Merci pour ces conseils.

    Cordialement,

    Riwal

    jeudi 31 mai 2012 11:11
  • je ne comprend pas ta remarque, la macro suivante fonctionne très bien avec ThisWorkbook
    mais il faut que le VBAProject(PERSO.XLS) soit existant et qu'il y ait un module1 avec du code.
    Sub CopyCode()
    Dim S                                           As String
        With Workbooks("PERSO.XLS").VBProject.VBComponents("Module1").CodeModule
            S = .Lines(1, .countoflines)
        End With
        With ThisWorkbook.VBProject.VBComponents("ThisWorkbook").CodeModule
            .AddFromString S
        End With
    End Sub

     --
    isabelle
    Le 2012-05-31 07:04, Riri_bzh a écrit :
    > Bonjour Isabelle,
    >
    > Ces méthodes ne fonctionnent pas sur ("ThisWorkbook").
    >
    > Merci de votre aide.
    >
    >

    dimanche 3 juin 2012 01:16
  • Bonjour Isabelle,

    C'est ce qui peut poser un problème...

    Perso.xls n'est pas censé exister au départ et il faut partir du principe qu'il n'existe pas. C'est pourquoi la solution du template reste idéale car elle n'impose rien que ce que décidera l'utilisateur sans jamais interférer l'existant.


    Argy

    lundi 4 juin 2012 07:26
    Modérateur
  • bonjour,
     
    ce n'est pas pertinent, je n'ai fait que montrer un exemple utilisant Workbooks("PERSO.XLS")
    il ne restait qu'a modifier le nom du fichier.
     
    --
    isabelle
     
    Le 2012-06-04 03:26, Argyronet [MVP] a écrit :
    > Bonjour Isabelle,
    >
    > C'est ce qui peut poser un problème...
    >
    > Perso.xls n'est pas censé exister au départ et il faut partir du principe qu'il n'existe pas. C'est pourquoi la solution du template reste idéale car elle n'impose rien que ce que décidera l'utilisateur sans jamais interférer l'existant.
    >
    > --------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
    >
    > Argy
    >
     
    samedi 16 juin 2012 01:03