Run-time error '-2147352571 (80020005)':

[brunounours]

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

 

[Misange]

Re : Run-time error '-2147352571 (80020005)':

Bonjour

Est-ce que tu remets l'imprimante par défaut de windows avant de refermer ton userform ?
Si avant de refermer le userform tu vas dans le panneau de config/imprimantes, quelle est celle qui est sélectionnée ?
Pourquoi au passage passer par une macro ProcédureImPrimanteParDéfaut qui ne fait qu'appeler une autre macro ChangeImprimanteParDéfaut.
A priori vu le message d'erreur tu devrais avoir une variable mal déclarée.
Si au lieu de passer par ton formulaire et le choix dans la combo tu lances le changement de macro directo depuis une macro test, as tu le même pb ?

en faisant une recherche avec cette erreur je tombe sur plusieurs pages dont celles-ci (si ça peut t'aider ?)
[RESOLVED] Provider error '80020005' - VBForums
Ce lien n'existe plus

 

[brunounours]

Re : Run-time error '-2147352571 (80020005)':

Bonjour

Est-ce que tu remets l'imprimante par défaut de Windows avant de refermer ton UserForm ?
Si avant de refermer l’userform tu vas dans le panneau de config/imprimantes, quelle est celle qui est sélectionnée ?

A 98% sur que le probleme ne viens pas de la. En effet, quelle que soit l'imprimante par défaut Windows, si j'exécute pour la première fois l'impression je n'ai pas de problème si je viens d'ouvrir le fichier. Sinon le problème persiste.

Pourquoi au passage passer par une macro Procédure ImPrimantearDéfaut qui ne fait qu'appeler une autre macro ChangeImprimanteParDéfaut.

Tu as raison, j'ai trouvé ce code déjà fait et je souhaitais l'adapter à mon cas. malg`´e cela le problème perciste.

Si au lieu de passer par ton formulaire et le choix dans la combo tu lances le changement de macro directo depuis une macro test, as tu le même pb ?

Je ne comprends pas ce que tu veux dire. Peux-tu un peu préciser stp!

Merci
Cdt Bruno

 

[Misange]

Re : Run-time error '-2147352571 (80020005)':

Si j'ai bien compris, actuellement, tu lances un formulaire qui te permet de choisir via une combo l'imprimante à utiliser.
Lance directement la macro
ChangeImprimanteParDéfaut(Nom As String) en lui injectant le nom de l'imprimante. As tu le même problème ?
Ce code est sur excelabo depuis très longtemps et personne n'a signalé de problème. J'aurais tendance à dire qu'il faut tester les 2% de risques d'échec qui restent.
De ce que tu décris ce n'est pas le lancement de la macro et de l'impression qui plante mais bien la sortie et le retour à la situation de départ qui ne se fait pas, d'où ma question sur le fait de resélectionner l'imprimante de départ. MAis je ne dis pas non plus que ça vient de là à 100% (ni même à 2!)

 

[MichD]

Re : Run-time error '-2147352571 (80020005)':

Bonjour,

Tiens, un pseudonyme qui m'est familier...! ;-))

Bonjour Misange

Je me suis permis de tester la procédure que tu as soumise et elle fonctionne correctement. Ce que tu savais déjà.

J'en soumets une autre...sans API

'-------------------------------------
Sub test1()

'Insérer le nom de l'imprimante tel qu'il apparaît dans le panneau de configuration.
call Imprimante_Par_Defaut ("NomDeLimprimante")

End Sub
'-------------------------------------

Sub Imprimante_Par_Defaut(Imprimante As String)
Dim strComputer As String
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colInstalledPrinters = objWMIService.ExecQuery _
("Select * from Win32_Printer Where Name = '" & Imprimante & "'")
For Each objPrinter In colInstalledPrinters
objPrinter.SetDefaultPrinter
Next

End Sub
'-------------------------------------


Salutations.

 

[brunounours]

Re : Run-time error '-2147352571 (80020005)':

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

 

[brunounours]

Re : Run-time error '-2147352571 (80020005)':

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

Metre des

.Value

apres les

.Additem

Merci pour votre aide.

Bruno

 

[MichD]

Re : Run-time error '-2147352571 (80020005)':

dans ta deuxième procédure, vers la fin de celle-ci, tu as ceci :

Suivant: '<<<<=========

Cette étiquette n'est pas définie, à quoi sert-elle ? Sinon, il faut l'enlever ou mettre une apostrophe devant.

 

[Misange]

Re : Run-time error '-2147352571 (80020005)':

Et salut MichD, ça fait vraiment plaisir de te voir ici
Reste ! (ou reviens plutôt). Manque plus que Daniel...

 

[Misange]

Re : Run-time error '-2147352571 (80020005)':

@brunounours
contente que tu aies résolu le problème.

 

[brunounours]

Re : Run-time error '-2147352571 (80020005)':

dans ta deuxième procédure, vers la fin de celle-ci, tu as ceci :

Suivant: '<<<<=========

Cette étiquette n'est pas définie, à quoi sert-elle ? Sinon, il faut l'enlever ou mettre une apostrophe devant.

Merci, c'était pour la lisibilité.
Comme ca marchait sans apostrophe je ne me suis pas vraiment posè la question.
Comme je n'avait jamais fait d'Excel VBA avant mon stage, je suis sur que mes codes ne sont pas les plus simples.
Au moins ils marchent. Pour les améliorer je verai un peu plus tard

Cdt, Bruno