Variable objet : pb de mémoire ?

Version imprimable

Bonjour !

Petit état des lieux pour un problème que je soupconne être lié à la mémoire :

- J'ai stocké une image dans le control image (Image1) d'un formulaire (MonUserForm).

- Ceci me permet par la suite d'attribuer cette image à une variable objet que j'apelle monImage.

- Enfin, je me sert de monImage pour définir la propriété Picture d'un commanButton que je créé dynamiquement sur une Sheet de mon Workbook

Problème, l'exécution du code marche la première fois. Mais la réexécution du code plante.
Le plus souvent, pas de code erreur, Excel plante. Quelquefois cependant, code erreur bizarre du genre -21546785214 (8450111)

Est-ce que quelqu'un à une idée 8O

Merci d'avance
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 Dim monImage as Object Dim newButton as OLEObject Set wbGAM = ThisWorkbook Set wbNEW = ActiveWorkbook wbGAM.Activate Set monImage = MonUserForm.Image1.picture wbNEW.Activate Set newButton = wbNEW.ActiveSheet.OLEObjects.Add ("Forms.CommandButton.1") With newButton .Left = 496.5 .Top = 163.5 .Width = 197.25 .Height = 111 .Object.Picture = monImage End With ...

26/09/2007, 11h56
Plateforme3

Bonjour

Citation:

Envoyé par laurentabj

Problème, l'exécution du code marche la première fois. Mais la réexécution du code plante.

J'ai testé le code et pas de soucis, même en le lançant plusieurs fois
Essaye avec une image plus petite !
Slts

Merci Plateforme3 pour ta réponse.

Mon image est toute petite (7.74 Ko).

Par contre le code que j'ai fourni n'est qu'une partie de ma procédure, et le plantage à lieu sur une autre partie du code. Le plus souvent c'est sur ça :

Code:

var = Application.Dialogs(xlDialogSaveAs).Show

Voici pour info la totalité de ma procédure. Mais celle-ci n'est qu'une petite partie du projet et ne pourra pas tourner sans le reste.

Code:

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
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
'
'
'Macro de création de fichier avec un onglet gamme                              15
'
Sub inserFeuilProc()
 
Dim var as Boolean
Dim ref As Object
Dim adresseRef As String
Dim wbGamName As String
Dim newButton As OLEObject
Dim codeButton As String
Dim NextLine As Integer
Dim monImage As Object
Dim nw As Integer 'créer ou non classeur
 
 
'On Error GoTo GestErreur
Set wbGAM = ThisWorkbook
Set wbNEW = ActiveWorkbook
wbGamName = wbGAM.Name
 
 
 
'tester si UN classeur est ouvert
If Workbooks.Count > 0 Then
    If Tester_Existence_Feuil_Process() = True Then
        wbGAM.Activate
        nw = MsgBox(wbGAM.Worksheets(csWSFORMS).Cells(150 _
            , wbGAM.Worksheets(csWSOPTIONS).Cells(1, 2).Value).Value _
            , vbInformation + vbYesNo _
            , wbGAM.Worksheets(csWSFORMS).Cells(151 _
            , wbGAM.Worksheets(csWSOPTIONS).Cells(1, 2).Value).Value)
        If nw = vbNo Then
            wbNEW.Activate
            Exit Sub
        End If
    End If
End If
 
'créer classeur et feuille
Set wbNEW = Workbooks.Add(xlWBATWorksheet)
Sheets(1).Name = cstrFPROC
Sheets(cstrFPROC).Cells.Font.Name = "Tahoma"
 
wbGAM.Activate
 
'copier coller de la feuille globale
Sheets(cstrFMODPROC & "_" & Sheets(csWSFORMS).Cells(3, Sheets(csWSOPTIONS).Cells(1, 2).Value).Value).Range(cstrZMODPROC).Copy
'Set monImage = usrImageSMB.imgSMB.Picture
wbNEW.Activate
 
ActiveSheet.Paste Destination:=ActiveWorkbook.Worksheets(cstrFPROC).Range(cstrRngProcess1)
Application.CutCopyMode = False
 
'adaptation de la largeur de colonnes
Sheets(cstrFPROC).Columns(cbyColPROCPers).ColumnWidth = clargColPers
Sheets(cstrFPROC).Columns(cbyColPROCID).ColumnWidth = clargColID
 
'mise en place de la liste des process sauf les colonnes volumes / heures/ prod
With Range(premCellListeProc)
    .Cells(1, cbyNPROC).FormulaR1C1 = wbGAM.Worksheets(csWSFORMS).Cells(162 _
            , wbGAM.Worksheets(csWSOPTIONS).Cells(1, 2).Value).Value
    .Cells(1, cbyINDXPROC).FormulaR1C1 = wbGAM.Worksheets(csWSFORMS).Cells(163 _
         , wbGAM.Worksheets(csWSOPTIONS).Cells(1, 2).Value).Value
    .Cells(1, cbyREFUO).FormulaR1C1 = wbGAM.Worksheets(csWSFORMS).Cells(164 _
         , wbGAM.Worksheets(csWSOPTIONS).Cells(1, 2).Value).Value
    .Cells(1, cbyNOMUO).FormulaR1C1 = wbGAM.Worksheets(csWSFORMS).Cells(165 _
          , wbGAM.Worksheets(csWSOPTIONS).Cells(1, 2).Value).Value
 
    Range(.Cells(1, cbyNPROC), .Cells(1, cbyDERNPROC)).BorderAround xlContinuous, xlThin, xlColorIndexAutomatic
    .Cells(1, cbyINDXPROC).BorderAround xlContinuous, xlThin, xlColorIndexAutomatic
    .Cells(1, cbyREFUO).BorderAround xlContinuous, xlThin, xlColorIndexAutomatic
    Range(.Cells(1, cbyNOMUO), .Cells(1, cbyDERUO)).BorderAround xlContinuous, xlThin, xlColorIndexAutomatic
 
    Range(.Cells(1, cbyNPROC), .Cells(1, cbyDERUO)).Font.Bold = True
'        .Cells(1, cbyINDXPROC).Font.Italic = True
    Range(.Cells(1, cbyINDXPROC), .Cells(1, cbyREFUO)).HorizontalAlignment = xlCenter
 
End With
 
    'modification du zoom + suppression du quadrillage
    ActiveWindow.Zoom = 80
    ActiveWindow.DisplayGridlines = False
 
 
    'nommer les zones
    Call NommerLesZones
 
    'recap process
    Call Entete_Recap
 
'Ajout bouton SMB
Set newButton = wbNEW.ActiveSheet.OLEObjects.Add("Forms.CommandButton.1")
With newButton
    .Left = 498
    .Top = 82.5
    .Width = 197.25
    .Height = 111
    .Object.Caption = "SMB"
    .Object.Font.Bold = True
    .Object.Font.Size = 30
    .Object.ForeColor = &H8000000D
'    .Object.Picture = monImage
End With
 
'création du code
'Workbooks.Application.Run "'Gammes v4 alpha (allégé).xla'!aj_SMB.AppelSMB"
 
codeButton = "Sub CommandButton1_Click()" & vbCrLf
codeButton = codeButton & "    On error REsume Next" & vbCrLf
codeButton = codeButton & "    Workbooks.Application.run " & Chr(34) & Chr(39) & wbGamName & "'!aj_SMB.AppelSMB" & Chr(34) & vbCrLf
codeButton = codeButton & "End Sub"
 
'Association du code
With ActiveWorkbook.VBProject.VBComponents("Feuil1").CodeModule
    NextLine = .CountOfLines + 1
    .InsertLines NextLine, codeButton
End With
 
 
'enregistrer sous
 
var = Application.Dialogs(xlDialogSaveAs).Show
If var = False Then
    wbNEW.Close SaveChanges:=False
    Exit Sub
End If
 
 
 
 
Exit Sub
GestErreur:
If Gestion_des_erreurs("WLD15/" & Err.Number) = True Then End
Resume Next
 
End Sub

26/09/2007, 13h49
ouskel'n'or

Question rituelles et récurrentes :
As-tu mis Option Explicit avant ton code ?
As-tu des Goto dans des boucles ?
As-tu des fonctions récurcives ?
As-tu essayé d'exécuter les macros en pas à pas ?
26/09/2007, 14h02
laurentabj

Merci ouskel'n'or.
Est-ce que ces réponses peuvent t'aider ?

Citation:

As-tu mis Option Explicit avant ton code ?

Oui

Citation:

As-tu des Goto dans des boucles ?

non

Citation:

As-tu des fonctions récurcives ?

non

Citation:

As-tu essayé d'exécuter les macros en pas à pas ?

Oui et le plantage à lieu le plus souvent sur ça (erreur 9) :

Code:

var = Application.Dialogs(xlDialogSaveAs).Show

Bonsoir,

Une autre méthode que tu peux éventuellement essayer:

Code:

1
2
3
4
5
6
7
8
Dim var As Variant
var = Application.GetSaveAsFilename( _
    fileFilter:="Fichier Microsoft Excel (*.xls), *.xls")
If VarType(var) = vbBoolean Then
    wbNew.Close SaveChanges:=False
Else
    wbNew.SaveAs var
End If

Cordialement,

Tirex28/

27/09/2007, 08h56
ouskel'n'or

Tu peux mettre seulement

Code:

Application.Dialogs(xlDialogSaveAs).Show

et comme le fichier "enregistré sous" est le classeur actif, tu as son nom.
27/09/2007, 11h37
laurentabj

OK je vais essayer tout ça. Merci !
27/09/2007, 11h55
laurentabj

Bon bah j'ai finalement résolu mon problème en copiant-collant la zone de code qui semblait "malade" depuis une ancienne version de mon projet qui fonctionnait.

Et là, plus de problème.
Pourtant, je ne vois pas la différence dans le code.

Mystère !! (mais résolu)

Merci à tous !