qd USEFROM non renseigné : pb dans macro

[vjoug]

Bonjour à toutes et tous, salut le fil.

Je vous soumet un petit soucis de macro que je parviens pas à résoudre.
Avant toute chose, je ne suis pas l'auteur de ce fichier.

Le but de ce fichier est d'extraire des états de stock ( reférences, désignation, stock, besoin....) d'une base de données type AS400, d'éliminer les doublons et de mettre en rouge les lignes où un stock négatif apparait.

Ce fichier fonctionne correctement qd dans mon USEFROM ( j'éspère qu'il s'agit du bon terme) je renseigne un nom l'atelier (LI ou LY ou TO.. par exemple).
Par contre il était prévu une extraction de l'ensemble des stocks (LI+ TO+ LY + ...) si l'userform n'était pas renseigné.

On peut trouver l'USEFORM qd on clique en haut à gauche.
Il est réprésenté par une loupe ( en dessous de la barre d'outil)
Pour lancer l'extraction on clique sur le symbole du dossier ouvert

Je rencontre un bug sur la ligne suivante
For p = 1 To Nb1
For i = 0 To 13
Cells(p + 1, i + 1) = LesEnregist1.Fields(i)
Next i

L'erreur est de type erreur d'exécution 3165 (de mémoire)
Est - ce mon code qui ne fonctionne pas ou une limite dans l'extraction?

D'autre part l'élimination des doublons est extremement longue ( il est vrai que j'ai prés de 7000 lignes. Quelqu'un saurait il m'aider à optimiser ma macro d'élimination des doublons?

Le fichier :
Free - Envoyez vos documents

Cordialement

 

[Law]

Re : qd USEFROM non renseigné : pb dans macro

Bonjour à toutes et tous, salut le fil.

Je vous soumet un petit soucis de macro que je parviens pas à résoudre.
Avant toute chose, je ne suis pas l'auteur de ce fichier.

Le but de ce fichier est d'extraire des états de stock ( reférences, désignation, stock, besoin....) d'une base de données type AS400, d'éliminer les doublons et de mettre en rouge les lignes où un stock négatif apparait.

Ce fichier fonctionne correctement qd dans mon USEFROM ( j'éspère qu'il s'agit du bon terme) je renseigne un nom l'atelier (LI ou LY ou TO.. par exemple).
Par contre il était prévu une extraction de l'ensemble des stocks (LI+ TO+ LY + ...) si l'userform n'était pas renseigné.

On peut trouver l'USEFORM qd on clique en haut à gauche.
Il est réprésenté par une loupe ( en dessous de la barre d'outil)
Pour lancer l'extraction on clique sur le symbole du dossier ouvert

Je rencontre un bug sur la ligne suivante
For p = 1 To Nb1
For i = 0 To 13
Cells(p + 1, i + 1) = LesEnregist1.Fields(i)
Next i

L'erreur est de type erreur d'exécution 3165 (de mémoire)
Est - ce mon code qui ne fonctionne pas ou une limite dans l'extraction?

D'autre part l'élimination des doublons est extremement longue ( il est vrai que j'ai prés de 7000 lignes. Quelqu'un saurait il m'aider à optimiser ma macro d'élimination des doublons?

Le fichier :
Free - Envoyez vos documents

Cordialement

Bonjour vjoug, le forum,
Je ne suis pas parvenu à ouvrir ton fichier.
Toutefois, pourrais-tu déjà préciser à quelle ligne exactement la macro bug ?
Si le message parle d'un problème de mémoire, indiques-nous déjà quelle est ta version d'Excel, de Windows, et de quelle quantité de mémoire vive dispose ton ordinateur ?
Ciao ciao !!

 

[vjoug]

Re : qd USEFROM non renseigné : pb dans macro

Salut LAw et re le fil,

Peut être que le téléchargement est resrvé aux abné Free?

Sinon ci dessous tu pourras trouver le code avec en rouge la portion qui pose soucis juste quand je ne renseigne pas le USF.

PC recent avec 2go de mémire vive sur XP SP3
Excel 2000 et XP
Cela echoue sur plusieurs (toutes?) configs tant matériel que soft


Cordialement
Vjoug

**************************************
Public classeur As Workspace
Public Base_v61 As Database
Public LesEnregist1 As Recordset, LesEnregist2 As Recordset
Public ident As String, mot_de_passe As String, site As String, classe As String
Public Connect As Boolean
Public w As Integer
Public ligne As Integer
Public site1 As String


Sub main()
Dim a As Integer

site1 = Sheets("suivi stock").[site]
Range(Rows(2), Rows(65000)).Select
Selection.ClearContents
Selection.Interior.ColorIndex = 2

If Connect = False Then
Set classeur = CreateWorkspace("", "admin", "", dbUseJet)
Set Base_v61 = classeur.OpenDatabase("BPCS", _
dbDriverNoPrompt, True, _
"ODBC;DATABASE=v61xxzz;UID=zzzzzzzzzzzz ;PWD= xxxxxxxxxxx;DSN=BPCS")
Connect = True
End If

If site1 <> "" Then
Set LesEnregist1 = Base_v61.OpenRecordset("SELECT WPROD,IIM.IDESC,IIM.IDSCE,IIM.IITYP,WOPB+WADJ+WRCT-WISS,WOPB+WADJ+WRCT-WISS-IWI.WCUSA,WOPB+WADJ+WRCT-WISS-IWI.WCUSA,IWI.WCUSA,IIM.IONOD,CIC.ICMIN,CIC.ICLOTS,AVM.VNDNAM,"""",WWHS FROM ((IWI INNER JOIN IIM ON (IWI.WPROD=IIM.IPROD)) INNER JOIN CIC ON (IWI.WPROD=CIC.ICPROD)) LEFT OUTER JOIN AVM ON (AVM.VENDOR=IIM.IVEND)WHERE WWHS='" & site1 & "' ")
Else:
Set LesEnregist1 = Base_v61.OpenRecordset("SELECT IIM.IDESC,WPROD,WWHS FROM IWI LEFT OUTER JOIN IIM ON (IWI.WPROD=IIM.IPROD)")
End If
'LA partie ci dessus sert à extraire les données de la base de données.

If LesEnregist1.BOF = False Then
With LesEnregist1
.MoveLast
.MoveFirst
Nb1 = (.RecordCount)
Debug.Print "" & Nb1 & ""
End With

For p = 1 To Nb1
For i = 0 To 13
Cells(p + 1, i + 1) = LesEnregist1.Fields(i)
Next i
Ca bug ici !

LesEnregist1.MoveNext
Next p
End If

LesEnregist1.Close

couleur

Range("C2").Select
Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

a = 1

While Cells(a + 1, 1) <> ""
While Cells(a, 1) = Cells(a + 1, 1)
Rows(a + 1).Delete
Debug.Print "" & a & ""
Wend
a = a + 1
Wend


End Sub

Sub couleur()
p = 2

While (Cells(p, 1) <> "")
If Cells(p, 6) < Cells(p, 7) And Cells(p, 7) > Cells(p, 10) Then
Cells(p, 13) = "REAPPRO EN COURS"
Rows(p).Interior.ColorIndex = 6
End If

If (Cells(p, 7) <= Cells(p, 10) And Cells(p, 7) < Cells(p, 10)) Then
Cells(p, 13) = "RISQUE RUPTURE"
Rows(p).Interior.ColorIndex = 3
End If

p = p + 1
Wend











End Sub

Sub change_site()

changesite.TextBox1.Value = Sheets("suivi stock").[site]
changesite.Show

End Sub

Sub auto_open()

Set mybar = CommandBars.Add(Name:="suivi stock", Position:=msoBarTop, Temporary:=True)
mybar.Visible = True

Set boutonsite = mybar.Controls.Add(Type:=msoControlButton)
boutonsite.OnAction = "change_site"
boutonsite.TooltipText = "changement de site"
boutonsite.Caption = "changement de site"
boutonsite.ShortcutText = "changement de site"
boutonsite.FaceId = 25

Set extrac = mybar.Controls.Add(Type:=msoControlButton)
extrac.OnAction = "main"
extrac.TooltipText = "extraction"
extrac.Caption = "extraction"
extrac.ShortcutText = "extraction"
extrac.FaceId = 23

End Sub

Sub auto_close()

CommandBars("suivi stock").Delete

End Sub
Sub test()
Range("C2").Select
Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom


End Sub

 

[jeanpierre]

Re : qd USEFROM non renseigné : pb dans macro

Bonjour vjoug, Law,

Ton fichier s'ouvre bien.

Impossible de faire le test, pas d'accés à ta base et c'est normal.

Néanmoins, testes la valeur de Nb1 au moment de d'erreur, je pense et à vue que le problème se situe là.

Encore que ton n° d'erreur ne me parle pas, notes le bien et surtout le message exact qui l'accompagne, s'il existe.

A te lire.

Jean-Pierre

 

[vjoug]

Re : qd USEFROM non renseigné : pb dans macro

Bonjour Jean-Pierre et le fil,

Autant Excel j'arrive à me débrouiller autant le VB j'ai pas encore franchi le pas.
Qu'entends tu par Tester la valeur de Nb1 ?

Je penchais pour une mauvaise déclarations de variable au départ.
En effet mais la mes connaissances snt limitées : Ne faut il pas déclarer Nb1 au début?


Cordialement
Vjoug

 

[jeanpierre]

Re : qd USEFROM non renseigné : pb dans macro

Re,

Si tu n'as pas utilisé Option Explicit en tête de module ni ailleurs, ce qui semble le cas dans ton fichier, il n'est pas besoin de déclarer. Perso.je ne le fais jamais.

Pour tester ta valeur, sous VBE et dans le module concerné, tu surlignes Nb1 et normalement tu as popup qui t'indique la valeur.

A te lire et surtout le message d'erreur et le n° (secondaire)

Bon WE.

Jean-Pierre

 

[vjoug]

Re : qd USEFROM non renseigné : pb dans macro

Bonjour Jean-pierre, Bonjour le fil,

L'erreur retournée est la suivante :
Erreur d'exécution "3265"
Element non trouvé dans cette collection

Concernant ta deuxième question, lorsque je surligne Nb1 et que je demande "infos express", il me renvoi "Implicit Nb1 As Variant"

EN espérant que cela puisse t'aider à m'aider

Coridalement

Vjoug