[XL-2007] Run-time error '-2147352571 (80020005)': [Résolu]

[brunounours]

Bonjour le forum!

Voici mon probleme:

Losque je lance ce code qui permet de choisir mon imprimante et d'imprimer mon Userform:

Code vb :

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
Const HWND_BROADCAST = &HFFFF
Const WM_WININICHANGE = &H1A
Private Declare Function GetPrivateProfileString Lib "Kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function GetWindowsDirectory Lib "Kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long
Private Declare Function WritePrivateProfileString Lib "Kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Dim Chemin As String
Dim NC As Long
Dim Ret As String
 
Private Sub CommandButton1_Click()
Imprdef = ComboBox1
ProcédureImPrimanteParDéfaut (Imprdef)
Me.PrintForm
End Sub
 
Private Sub UserForm_Initialize()
'ComboBox1.RowSource = "listeImpr"
ComboBox1.AddItem "PDFCreator"
ComboBox1.AddItem "\\adrfp1\ADRPR_CTS3"
ComboBox1.AddItem "ADRPR_CTS3"
 
'ListBox1 = userformverficacion2.ListBox1
End Sub
 
Private Sub ProcédureImPrimanteParDéfaut(Imprdef)
 'http://www.lesite.net/trucs/imprimante_defaut
   ChangeImprimanteParDéfaut (Imprdef)
  End Sub
 
  Sub ChangeImprimanteParDéfaut(Nom As String)
'http://www.lesite.net/trucs/imprimante_defaut
 Chemin = String(260, 0)
 Chemin = Left$(Chemin, GetWindowsDirectory(Chemin, Len(Chemin))) + "\win.ini"
 Ret = String(255, 0)
 NC = GetPrivateProfileString("Devices", Nom, "", Ret, 255, Chemin)
 Ret = Left(Ret, NC)
 WritePrivateProfileString "windows", "device", Nom & "," & Ret, Chemin
 SendMessage HWND_BROADCAST, WM_WININICHANGE, 0, "windows"
 End Sub

La fonction est bien réalisée. En revanche, apres mon impression, et après avoir fermé l'UserForm imprimé, aucune de mes macros ne fonctionnent:
si je clique sur un bouton qui lance n'importe quelle Userform, un message d'erreur apparait:

Run-time error '-2147352571 (80020005)':
Could not set the Value property. type mismach.

Si je clique sur debug il me surligne: UserForm.Show

Je n'ai trouvé d'autre solution que de fermer mon fichier et de le rouvrir: Ce qui est tres contraignant si je dois le faire après chaque impression.

J'ai peut être une idée: Existe t'il un code pour remettre les parametres de base de excel par defaut que j'executerai à la fermeture de mon UserForm ou faut il que je modifie mon code?

Merci d'avance.

Cdt Bruno

[Qwazerty]

Salut
Lorsque ton code plante et te surligne UserForm.Show, utilise la touche F8 pour avancer pas à pas jusqu’à la ligne qui provoque réellement l'erreur.

++
Qwaz

[brunounours]

En suivant les etapes de débug utilisant F8, je me suis apercu qu'il n'y avait pas de probleme pour l'ouverture des UserForm. En faite j'ai un probleme dans 2 boucles différentes.

Ce que je ne comprends pas, c'est que ces boucles marchent bien avant de lancer une impression.

voici les 2 boucles qui possent probleme:

Boucle1:

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
End Sub
 
Private Sub UserForm_Initialize()
 
  TextBox1 = Format(Range("B3"), "dd/mm/yyyy")
 
  TextBox2 = Format(Range("C3"), "dd/mm/yyyy")
 
   'TextBox1 = 1
  ' TextBox2 = 2
 
  'TextBox1 = Range("B3")
 ' TextBox2 = Range("C3")
 
'Charger liste deroulante
 
Dim J As Long
Dim Ws As Worksheet
 
ComboBox1.Clear
 
 
 
If TextBox1.Text = "" Or TextBox2.Text = "" Then Exit Sub
 
  Set Ws = Sheets("OEP CONTROL")
  With UserformVerificacion.ComboBox1
    .ColumnCount = 2
    .ColumnWidths = "-1;0"
 
    For J = Ws.Range("D" & Rows.Count).End(xlUp).Row To 11 Step -1
 
    If Ws.Range("A" & J).Value >= CDate(TextBox1.Text) And Ws.Range("A" & J).Value <= CDate(TextBox2.Text) Then
 
            If Ws.Range("D" & J) <> "" Then
          .AddItem Ws.Range("D" & J)
          .List(.ListCount - 1, 1) = J
 
    End If
    End If
    Next J
  End With
 
End Sub

Probleme avec: .AddItem Ws.Range("D" & J)


Boucle 2 :

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
Private Sub UserForm_Initialize()
   TextBox1 = Format(Range("B3"), "dd/mm/yyyy")
   TextBox2 = Format(Range("C3"), "dd/mm/yyyy")
   TextBox3 = Format(Date, "dd/mm/yyyy")
End Sub
 
Private Sub CommandButton1_Click()
 
Dim i As Long
Dim Sh As Worksheet
Dim Chk As MSForms.Control
 
Dim Bol As Boolean
 
Dim iTag As Byte
Dim str() As String
Dim strFiltre() As String
 
Set Sh = ThisWorkbook.Worksheets("OEP CONTROL")
 
'Vide les listBox
ListBox1.Clear
ListBox2.Clear
ListBox3.Clear
ListBox4.Clear
 
 
 
'Test si saisie des dates
If TextBox1.Text = "" Or TextBox2.Text = "" Then Exit Sub
 
'Boucle sur les lignes de données (de la ligne 11 à la dernière ligne utilisée)
For i = 11 To Sh.Range("A" & Sh.Rows.Count).End(xlUp).Row
 
    'Test le bornage de date
 
    If Sh.Range("A" & i).Value >= CDate(TextBox1.Text) And Sh.Range("A" & i).Value <= CDate(TextBox2.Text) Then
 
        'Boucle sur les Checkboxs
        For Each Chk In Me.Controls
 
            If TypeOf Chk Is MSForms.CheckBox Then
                Bol = False
                If Chk.Value = True And Chk.Tag <> "" Then
                    str = Split(Chk.Tag, "/")
                    strFiltre = Split(str(1), "-")
                    For iTag = 0 To UBound(strFiltre)
                        If UCase(Sh.Range(str(0) & i).Value) = UCase(strFiltre(iTag)) And Bol = False Then
                            Bol = True
                            GoTo Trouve
                        End If
                    Next iTag
                End If
 
            End If
 
        Next
Trouve:
        'Ajoute la référence si ok
        If Bol = True Then ListBox1.AddItem Sh.Range("D" & i).Value
        If Bol = True Then ListBox2.AddItem Sh.Range("B" & i).Value
               If Bol = True Then ListBox4.AddItem Sh.Range("K" & i).Value
 
 
         End If
 
Suivant:
 
Next i
 
End Sub

Problème avec la boucle à la 6ème itération.

J'ai tourné le problème dans tous les sens en ne trouve rien de concret.

Une idée, Bruno

[Qwazerty]

Salut
Essai avec

Code :

.AddItem Ws.Range("D" & J).value

Sinon si rien de confidentiel, si tu pouvais mettre un fichier demo.
++
Qwaz

[brunounours]

Magnifique! En ajoutant des

Code :

.Value

un peu partout apres les

Code :

.additem

ca fonctionne niquel :-D

Merci Beaucoup car je commençais à désesperer

Bruno