AddFromFile fait planter excel

[linked]

Bonjour,

Je tente de faire une mise à jour automatique par macro du code se trouvant sur la feuil1 s'appelant OT avec le code ci dessous:

With Workbooks(Nom).VBProject.VBComponents(ActiveWorkbook.Sheets("OT").CodeName).CodeModule
.DeleteLines 1, .CountOfLines
.AddFromFile ("D:\Programmation et travaux\macro\F1.txt")
.CodePane.Window.Close
End With

Apres Addfromfile excel plante lamentablemet et windows veut envoyer un rapport d'erreur mais j'ai quand meme le temps de voir qu'il a bien inclu le contenu du fichier F1.txt...
Si je remplace Addfromfile par addfromstring "Option explicite"(par exemple) je n'ai pas d'erreur du tout.
Que faire ?

edit: J'ai tenté avec "Option explicite" comme seule ligne dans F1.txt et cela fonctionne mais des que je met ne serait ce que:

Option Explicit
Private Sub CommandButton_magasin_Click()
menu_magasin.Show
End Sub

Et ben avec ca excel plante...

 

[MichelXld]

Re : AddFromFile fait planter excel

bonsoir


Ta procédure fonctionne sans problème chez moi.


A tout hasard, tu peux tester cette adaptation:

Dim Cm As Object
 
Set Cm = Workbooks(Nom).VBProject.VBComponents(Workbooks(Nom). _
    Sheets("OT").CodeName).CodeModule
 
With Cm
    .DeleteLines 1, .CountOfLines
End With
 
DoEvents

Cm.AddFromFile ("C:\F1.txt")
Cm.CodePane.Window.Close

Bonne soirée
MichelXld

 

[dmc]

Re : AddFromFile fait planter excel

Bonsoir à tous, avec mes amitiés renouvelées.
Je reprends ce vieux fil, car il correspond vraiment au problème que je rencontre. (au moins, ça prouve que j'ai cherché avant de poser mon pb !!)
le code ci-àprès déclenche un plantage total de Excel

Sub maliste_de_boites()
Dim coche As OLEObject
Dim VBC  As Object '''As VBIDE.VBComponent
Dim A$
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = "Souhaitez-vous continuer?"    ' Définit le message.
Style = vbYesNo + vbCritical + vbDefaultButton2    ' Définit les boutons.
Title = "Démonstration de MsgBox "    ' Définit le titre.
Help = "DEMO.HLP"    ' Définit le fichier d'aide.
Ctxt = 1000    ' Définit le contexte de MichelXLD en début pour le delete des instructions déjà présentes :                 ' la rubrique.
 
    ActiveSheet.OLEObjects.Delete
        For lig = 3 To 5
            Set coche = ActiveSheet.OLEObjects.Add( _
                ClassType:="Forms.CheckBox.1", _
                Link:=False, DisplayAsIcon:=False, _
                Left:=107, Top:=Range("D" & lig).Top, _
                Width:=Range("D" & lig).Width, Height:=Range("D" & lig).Height)
 
            With coche
                .Name = "coche" & lig
                '.Object.Caption = "coche" & lig
                .Object.Caption = .Name
                .Object.Value = Range("D" & lig).Text = 1
            End With
 
            '### code du bouton ###
            Set VBC = ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
 
            textinstruct = _
            "if coche3.value=true then Range(""A" & "" & lig & """).value = 1 else Range(""A" & lig & """).value = """""
 
            A$ = vbCrLf & "Private Sub " & coche.Name & "_Click()" & _
                    vbCrLf & textinstruct & _
                    vbCrLf & "End Sub"
 
            ' Affiche le message.
            Response = MsgBox(A$, Style, Title, Help, Ctxt)
                If Response = vbYes Then    ' L'utilisateur a choisi Oui.
                    MyString = "Oui"    ' Effectue une action.
                    VBC.AddFromString A$
 
                Else    ' L'utilisateur a choisi Non.
                    MyString = "Non"    ' Effectue une action.
                End If
 
        Next
End Sub

ce plantage a lieu au moment ou on passe sur l'instruction next.
par contre, le 1er controle est parfaitement créé sur la feuille cible, active avant lancement.

Je ne m'en sors abolument pas, et c'est pire si j'insère le code de MichelXLD: au moment d'enregistrer ma macro, j'obtiens un message m'indiquant un pb de fichier déterioré, puis mon antivurus (bit defender) me dit qu'il m'a protégé du virus nommé Macro.VBA, puis je perds tout mon fichier et je recommence à zéro.
ouye ouye aie. Que faire ?
mon objectif :
ma macro ouvre successivement un grand nombre de fichiers pour les traiter l'un après l'autre :
- elle les standardise en présentation
- elle les enrichit en informations
- elle y implante (elle cherche à y implanter !!) une case à cocher sur chaque ligne détail, et le code de chaque case à cocher qui va avec.
c'est là que je foire, et que j'ai besoin de votre aide.
merci d'avance

 

[dmc]

Re : AddFromFile fait planter excel

apès plusieurs essais, je joins ci-dessous le script que j'ai tenté de corriger au mieux, et qui plante toujours autant.

Sub maliste_de_boites()
Dim coche As OLEObject
Dim Msg, Style, Title, Help, Ctxt, Response, MyString
Msg = "Souhaitez-vous continuer?"    ' Définit le message.
Style = vbYesNo + vbCritical + vbDefaultButton2    ' Définit les boutons.
Title = "l'instruction est-elle correcte ? "    ' Définit le titre.
Help = "DEMO.HLP"    ' Définit le fichier d'aide.
Ctxt = 1000    ' Définit le contexte de la rubrique.
    ActiveSheet.OLEObjects.Delete
        For lig = 3 To 5
            Set coche = ActiveSheet.OLEObjects.Add( _
                ClassType:="Forms.CheckBox.1", _
                Link:=False, DisplayAsIcon:=False, _
                Left:=107, Top:=Range("D" & lig).Top, _
                Width:=Range("D" & lig).Width, Height:=Range("D" & lig).Height)
            With coche
                .Name = "coche" & lig
                '.Object.Caption = "coche" & lig
                .Object.Caption = .Name
                .Object.Value = Range("D" & lig).Text = 1
            End With
            '### code du bouton ###
            textinstruct = _
            "if coche" & lig & ".value=true then Range(""A" & "" & lig & """).value = 1 else Range(""A" & lig & """).value = """""
            'A$ = vbCrLf & "Private Sub " & coche.Name & "_Click()" & _
                    vbCrLf & textinstruct & _
                    vbCrLf & "End Sub"
            ' Affiche le message.
            Response = MsgBox(A$, Style, Title, Help, Ctxt)
                If Response = vbYes Then    ' L'utilisateur a choisi Oui.
                    MyString = "Oui"    ' Effectue une action.
                    With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
                        .InsertLines .CountOfLines + 1, "Private Sub " & coche.Name & "_Click()"
                        .InsertLines .CountOfLines + 1, textinstruct
                        .InsertLines .CountOfLines + 1, "End Sub"
                    End With
                Else    ' L'utilisateur a choisi Non.
                    MyString = "Non"    ' Effectue une action.
                End If
        Next
End Sub

c'est quand même dingue que je n'arrive pas à écrire cette petite macro, non ? vous allez me tirer de là, comme d'habitude, hein ....?
merci, d'avance

 

[kjin]

Re : AddFromFile fait planter excel

Bonsoir,
Peut-être comme ceci si j'ai compris qq chose

Sub maliste_de_boites()
Dim Coche As OLEObject, Ws As Worksheet, Ligne As Byte, VBC As Object

Set Ws = ActiveSheet
Ws.OLEObjects.Delete

    For Ligne = 3 To 5
        Set Coche = Ws.OLEObjects.Add(ClassType:="Forms.CheckBox.1", _
        Left:=107, Top:=Range("D" & Ligne).Top, Width:=Range("D" & Ligne).Width, _
        Height:=Range("D" & Ligne).Height)
            
        Coche.Name = "Coche" & Ligne
        Coche.Object.Caption = "Coche" & Ligne
 
        With ThisWorkbook.VBProject.VBComponents(Coche.Parent.Name).CodeModule
            .InsertLines .CreateEventProc("Click", Coche.Name) + 1, _
            "If " & Coche.Name & ".Value = True Then" & vbCrLf _
            & "Range(""A" & Ligne & """).Value = 1" & _
            vbCrLf & _
            "Else: Range(""A" & Ligne & """).value = """"" & vbCrLf & "End If"
        End With
    Next
            
End Sub

A+
kjin

 

[dmc]

Re : AddFromFile fait planter excel

Bonsoir KJIN, merci pour ton aide.
J'ai testé ton script, et j'obtiens le message suivant :
erreur 57017
gestionnaire d'évenements non valide

est-ce mon poste qui aurait un problème ?
j'utilise excel 2007, sous Vista
je n'ai pas de pb en général avec les macro !

qu'en penses-tu?
@+

 

[dmc]

Re : AddFromFile fait planter excel

re bonsoir KJIN
je rectifie mon post précédent. en y regardant de plus près, et surtout en téléchargeant le fichier exemple que tu as joint, j'ai constaté que ton script marche très bien.
MAIS: il modifie le classeur en cours, et non pas un autre classeur, et il semble que cette différence provoque mon plantage.
Pour être donc plus précis la-dessus, et que tu puisses compléter ce script:
- la macro est lancée à partir du classeur "ma_source de macros"
- elle modifie des fichiers origine1.xls à origine999.xls situés dans le repertoire "repertoire_origine"
- elle "enrichit" pour chacun d'entre eux la première feuille avec les checkbox et les scripts correspondants
- elle enregistre le résultat dans le sous-répertoire "traités" de "ma_source de macros".

cela n'a l'air de rien, mais les différents détails me permettant de jongler entre les différentes feuilles me rendront un très grand service.

Merci de me proposer ta solution.
@+, cordialement.

 

[kjin]

Re : AddFromFile fait planter excel

Re,
Je ne sais pas ajouter du code et encore moins des objets dans un classeur fermé; avec 999 classeurs ça risque d'être long ! 😀

Sub maliste_de_boites()
Dim Rep1 As String, Rep2 As String, Fich As String, Trouve As String
Dim Coche As OLEObject, Ws As Worksheet, Ligne As Byte, VBC As Object

Rep1 = "C:\....repertoire_origine....\" 'à adapter
Rep2 = "C:\...traités....\" 'à adapter
Fich = "Origine*.xls"
Trouve = Dir(Rep1 & Fich)

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Do While Trouve <> ""

Workbooks.Open Rep1 & Trouve

Set Ws = Sheets("Feuil1") 'à adapter
Ws.OLEObjects.Delete

    For Ligne = 3 To 5
        Set Coche = Ws.OLEObjects.Add(ClassType:="Forms.CheckBox.1", _
        Left:=107, Top:=Range("D" & Ligne).Top, Width:=Range("D" & Ligne).Width, _
        Height:=Range("D" & Ligne).Height)
            
        Coche.Name = "Coche" & Ligne
        Coche.Object.Caption = "Coche" & Ligne
 
        With ActiveWorkbook.VBProject.VBComponents(Coche.Parent.Name).CodeModule
            .InsertLines .CreateEventProc("Click", Coche.Name) + 1, _
            "If " & Coche.Name & ".Value = True Then" & vbCrLf _
            & "Range(""A" & Ligne & """).Value = 1" & _
            vbCrLf & _
            "Else: Range(""A" & Ligne & """).value = """"" & vbCrLf & "End If"
        End With
    Next

    ActiveWorkbook.SaveAs Rep2 & Trouve
    ActiveWorkbook.Close
    
Trouve = Dir
Loop

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

A+
kjin