Run-time error '-2147352571 (80020005)

Bonjour le forum!

Voici mon probleme:

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

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.excelabo.net/trucs/imprimante_defaut
   ChangeImprimanteParDéfaut (Imprdef)
  End Sub

  Sub ChangeImprimanteParDéfaut(Nom As String)
'http://www.excelabo.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

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:

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)

O boucle 2=

"

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

"21

Probleme avec la boucle à la 6ème iteration

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

Une idée?? Bruno

C'est bon j'ai trouvé une solution:

Metre des

.Value

apres les

.Additem

Merci pour votre aide.

Bruno