IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Echec de la méthode Add de oleoobjects


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre éclairé
    Homme Profil pro
    Inscrit en
    Octobre 2010
    Messages
    338
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Rhône (Rhône Alpes)

    Informations forums :
    Inscription : Octobre 2010
    Messages : 338
    Par défaut Echec de la méthode Add de oleoobjects
    Il plante lors de l'ajout du bouton. Voici le code

    Etape 1 : Double clique dans une cellule ==> propose l'ajout de donnée
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
     
        If Not Intersect(Target, Feuil1.Range("C7:C" & Feuil1.Range("B1048576").End(xlUp).Row + 1)) Is Nothing Then 'si double click dans la cellule correspondant au product code
            If (ActiveCell.Offset(columnOffset:=-1)) <> "" Then
                Select Case MsgBox("Souhaitez vous ajouter/remplacer des datas pour le point " & ActiveCell.Offset(columnOffset:=-1) & " ?", vbYesNo + vbQuestion, "Ajout data")
                    Case vbYes
                        Call ajout
                    Case vbNo
                        Exit Sub
                End Select
            End If
        End If
    End Sub
    Etape 2 =Ajoute les datas à partir d'un autre fichier
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    Sub ajout() 'import du fichier étalon
     
        Dim File As String 'déclaration de variables
        Dim Fichier As Workbook
        Dim Lig As Long, Col As Long
     
        Lig = ActiveCell.Row
     
        File = strChooseFile("Indiquer le fichier de données", "Z:\3-MANUFACTURING\3-MANIP DATA\_" & Format(Date, "YYYY") & "\_PROD\") 'choix du fichier etalon par défaut
     
        If File = vbNullString Then
            Select Case MsgBox("Aucun fichier sélectionné", vbExclamation + vbOKOnly, "Pas de fichier sélectionné")
                Case vbOK
                    Exit Sub
            End Select
        End If
     
        Set Fichier = Application.Workbooks.Open(File) 'ouvre le fichier
        Fichier.Sheets(1).Range("E2:S2").Copy Feuil1.Range("C" & Lig) 'Copie-colle le tableau récap étalon dans le fichier de calibration LAGRANGE
        Fichier.Close False 'ferme le fichier gestion des étalons sans sauvegarder
     
    End Sub

    Etape 3 ==> modification valeur de la feuille
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    Private Sub Worksheet_Change(ByVal Target As Range) 'se déclenche si l'on change une valeur de cellule (définie par Target)
     
        Dim i As Long, j As Long, c As Long 'Définition de variable
        Dim k As Integer
        Dim Obj  As OLEObject
        Dim Bool3 As Boolean
     
        If Not Intersect(Target, Feuil1.Range("C8:C" & Feuil1.Range("B1048576").End(xlUp).Row + 1)) Is Nothing Then
            j = Feuil1.Range("B1048576").End(xlUp).Row + 1 'recherche dernière ligne dans calibration data
            c = j
            k = Feuil2.Range("A3").End(xlDown).Row
            For Lig = 8 To j Step 1
                If Feuil1.Range("B" & Lig) = "Check" Then c = Lig
                Bool3 = False
                If Lig > c And Feuil1.Range("C" & Lig) <> "" Then
                    For Each Obj In Feuil1.OLEObjects
                        If Obj.Name = "Check_" & Lig Then Bool3 = True 'si le nom du bouton est différent de MAJ alors on le supprime
                    Next Obj
                    If Bool3 = False Then
                        Set WB = ThisWorkbook
                        crcbx Lig, WB 'fonction ajout bouton
                    End If
                End If
            Next Lig
        End If
    End Sub
    fonction d'ajout du bouton qui bloque !
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    Public Function crcbx(ByVal z As Integer, ByVal WKB As Workbook) 'fonction pour la création des boutons
     
        Dim X As Integer
     
        WKB.Activate
        Feuil1.Unprotect
     
        Set Obj = Feuil1.OLEObjects.Add("Forms.ToggleButton.1") 'ajout d'un bouton==> cette ligne crée une erreur
        Obj.Height =Feuil1.Range("A" & z).Height 'hauteur du bouton
        Obj.Width = Obj.Height 'largeur du bouton
        Obj.Left = Feuil1.Range("B" & z).Left - Obj.Width 'position du bouton horizontal
        Obj.Top = Feuil1.Range("A" & z).Top 'position du bouton vertical
        Obj.Object.BackColor = RGB(0, 255, 0) 'couleur du fond du bouton vert
        Obj.Object.Caption = "" 'valeur du texte
        Obj.Name = "Check_" & z 'nom du bouton
     
        With WKB.VBProject.VBComponents("Feuil1").CodeModule
            X = .CountOfLines
            .InsertLines X + 1, "Sub Check_" & z & "_Click()"
            .InsertLines X + 2, vbTab & "If Check_" & z & ".Value = True Then"
            .InsertLines X + 3, vbTab & vbTab & "Check_" & z & ".BackColor = RGB(255, 0, 0)"
            .InsertLines X + 4, vbTab & "Else"
            .InsertLines X + 5, vbTab & vbTab & "Check_" & z & ".BackColor = RGB(0,255, 0)"
            .InsertLines X + 6, vbTab & "End if"
            .InsertLines X + 7, "End Sub"
        End With
     
        Feuil1.Unprotect
        Feuil1.Range("A1:XFD1048576").Locked = True
        Feuil1.Range("B2,B3,G3,I3,J3,L3").Locked = False
        Feuil1.Range("B7:Y1048576").Locked = False
        Feuil1.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, UserInterfaceOnly:=True, AllowFormattingCells:=False, AllowFormattingColumns:=False, AllowFormattingRows:=False, AllowInsertingColumns:=False, AllowInsertingRows:=False, AllowInsertingHyperlinks:=False, AllowDeletingColumns:=False, AllowDeletingRows:=False, AllowSorting:=False, AllowFiltering:=False, AllowUsingPivotTables:=False
     
    End Function
    Je n'arrive pas à comprendre pourquoi il me jette !

    Je pensais que c'était du fait qu'un autre était ouvert ou alors de la protection de la feuille. Mais je m'affranchis de ça avec set WB=thisworkbook et feuil1.unprotect. Des suggestions ?

  2. #2
    Expert confirmé
    Homme Profil pro
    aucune
    Inscrit en
    Avril 2016
    Messages
    7 563
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 84
    Localisation : France, Pyrénées Atlantiques (Aquitaine)

    Informations professionnelles :
    Activité : aucune

    Informations forums :
    Inscription : Avril 2016
    Messages : 7 563
    Par défaut
    Bonjour
    as-tu pensé à vérifier combien vaut la variable lig lorsque tu appelles ta fonctions ? Déclarée en integer, tu auras un plantage si elle vaut plus que la valeur limite d'un integer !

  3. #3
    Membre éclairé
    Homme Profil pro
    Inscrit en
    Octobre 2010
    Messages
    338
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Rhône (Rhône Alpes)

    Informations forums :
    Inscription : Octobre 2010
    Messages : 338
    Par défaut
    Bonjour unparia,

    Merci de ta réponse, j'ai effectivement vérifié Lig qui dépasse rarement la valeur de 20. J'ai fait retourner le code et il à l'air de fonctionner et parfois de planter. Du coup je pense à un conflit potentiel de variable du genre WB ou WKB mal défini. je vais essayer de retoiletter mon code pour le rendre plus sûr.

Discussions similaires

  1. Méthode add() de l'objet select
    Par webrider dans le forum Général JavaScript
    Réponses: 2
    Dernier message: 30/01/2008, 14h01
  2. Méthode add de l'objet AllowEditRange fonctionne... maintenant
    Par ouskel'n'or dans le forum Macros et VBA Excel
    Réponses: 3
    Dernier message: 26/09/2007, 12h58
  3. méthode add dans une classe héritant de ArrayList
    Par sliderman dans le forum Collection et Stream
    Réponses: 7
    Dernier message: 05/06/2007, 09h27
  4. [Zip] Erreur avec la méthode add() de PclZip
    Par Anduriel dans le forum Bibliothèques et frameworks
    Réponses: 8
    Dernier message: 20/01/2007, 16h42
  5. surcharge de la méthode Add d'une List
    Par Anto03 dans le forum C#
    Réponses: 4
    Dernier message: 19/01/2007, 14h12

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo