Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Déclarations et soustractions de variables

Calvus

XLDnaute Barbatruc
Bonjour le forum,

Avant de poster un fichier, pouvez vous me dire si vous voyez une raison du non fonctionnement du code ci-dessous ?

Est ce dû à une mauvaise déclaration ou à la formulation ? Ce qui serait étonnant car le même type de calcul se fait sur les autres lignes de code.

VB:
Dim cl As Range, cbl, cbl2, cbl3, cblaa, cbla, cbla1, stock, cel, stockval As Range, val As Range, valtemp As Range


 Set stockval = Feuil24.Columns(3).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Find(cel).Offset(, 6) 'stockval = quantité en feuille stock
Set val = cel.Offset(, 2) 'quantité en BL
                        If cel.Offset(, -2) = "" And cel <> "" Then
                        Feuil34.Range("C" & Lg) = cel
                          If val > stockval Then
                          Feuil34.Range("E" & Lg) = val - stockval
Set df = Feuil34.Range("E" & Lg)
Set valtemp = val - df

La dernière variable (valtemp), et elle seulement renvoie Nothing, alors que toutes les autres ont des valeurs positives.

Merci de votre aide
 

pierrejean

XLDnaute Barbatruc
Re : Déclarations et soustractions de variables

Bonjour Calvus

Je ne suis pas un grand spécialiste en déclaration de variable ersonnellement je laisse Excel déclarer mes variables en Variant
Néanmoins je te suggère de remplacer
Set valtemp = val - df
par
valtemp.Value=val.Value-df.Value

Edit :Salut Papou-net
 

Calvus

XLDnaute Barbatruc
Re : Déclarations et soustractions de variables

Bonjour Papounet et Pierrejean,

Je ne suis pas certain de l'erreur, mais je vois que tu as utilisé un mot réservé pour la variable val?

Que veux tu dire par là ?

@Pierrejean : j'ai essayé tes propositions, sans succès malheureusement.
En déclarant As Variant, j'obtiens vide au lieu de Nothing.
Alors que val donne 9 et df 7.

Merci
 

pierrejean

XLDnaute Barbatruc
Re : Déclarations et soustractions de variables

Je ne t'ai pas proposé de déclarer en Variant (ça c'est Excel qui le fait pour moi)
Par contre as-tu bien mis

valtemp.Value=val.Value-df.Value Sans le Set

Je suis également d'avis de choisir un autre nom pour val (qui est une fonction d'Excel) : Merci Papou-net
 

Calvus

XLDnaute Barbatruc
Re : Déclarations et soustractions de variables

Re,

En attendant le fichier, voici la macro jusqu'au point qui pose problème.
C'est la dernière partie dont il s'agit, à partir de dim df.

Merci.

VB:
'Validation BL
Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
'On Error GoTo fin
Dim start As Single
start = Timer

Dim cl As Range, cbl, cbl2, cbl3, cblaa, cbla, cbla1, stock, cel, stockval As Variant, vali As Variant, valtemp As Variant
Dim nouvonglet, nouvonglet2 As String, c As Range, LePath As String, LeNom As String, fichier As String, Dossier As String, Chemin As String, sh As Shape, n As Name
Set cbl = Feuil33.Columns(4).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Find([E8])   'Numéro de commande en feuille Etat des Commandes
Set cbl2 = Feuil33.Columns(8).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Find([E8])  'Numéro de commande bis en feuille Etat des Commandes
Set cbl3 = Feuil33.Columns(12).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Find([E8])  'Numéro de commande bis en feuille Etat des Commandes
Set cblaa = Feuil33.Columns(8).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Find(Feuil30.[H8])  'Numéro de commande bis du Bl temp en feuille Etat des Commandes
Set cbla1 = Feuil33.Columns(8).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Find(Feuil30.[E8])  'Numéro de commande bis du Bl temp en feuille Etat des Commandes
Set cl = Sheets("Clients").Columns(2).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Find([B12]) 'Client en feuille Clients
Dim Lg, Lg2 As String

[A:A].ClearContents
'Vérification du stock
For Each cel In Range("C20:C53, C83:C116")
Set stock = Feuil24.Columns(3).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Find(cel)  'stock = référence en feuille stock
If stock Is Nothing Then GoTo suite
If stock.Offset(, 6) < 1 Then cel.Offset(, -2) = "x"        'si stock est inférieur à 1 alors mettre un x en colonne A
Next cel

suite:

If [H12] = "Livraison Partielle " Then GoTo Bltemp



'cbl = équivalent BL de la commande en feuille Etat des commandes
If Application.CountIf([E8], "*bis") Then
                If cbla1.Offset(, 6) <> "" Then
                MsgBox ("BL 3 déjà existant !")
                Exit Sub
                End If
                If cbla1.Offset(, 2) <> "" Then
                MsgBox ("BL 2 déjà existant !")
                Exit Sub
                Else: GoTo continue
                End If
                
ElseIf Application.CountIf([E8], "*ter") Then
                If cblaa.Offset(, 6) <> "" Then
                MsgBox ("BL 3 déjà existant !")
                Exit Sub
                Else: GoTo continue
                End If
                'cbl.Offset(, 2) <> "" Then
MsgBox ("BL déjà existant !")
'End If
Exit Sub
End If

continue:

If MsgBox("Pensé à changer de client ?", vbYesNo) = vbNo Then
Exit Sub
End If

With [B12] 'cl = B12 (client) en feuille client
.Offset(1, 0) = cl.Offset(0, 1) & " " & cl.Offset(0, 2)
.Offset(2, 0) = cl.Offset(0, 4)
.Offset(3, 0) = cl.Offset(0, 5)
.Offset(3, 1) = cl.Offset(0, 6)
.Offset(-7, 5) = cl.Offset(0, -1)
End With

' Numérotation du BL et de la date
[J9] = [J9] + 1
[E5] = "BL N° " & [J9]
[F5] = Date

Application.ScreenUpdating = True
    
    If [G5] <> [G8] Then
        If MsgBox("2 codes client différents ? Etes vous sûr de continuer ?", vbYesNo) = vbNo Then 'Retour en arrière
        [J9] = [J9] - 1
        [E5] = "BL N° " & [J9]
        Exit Sub
        End If
    End If

If MsgBox("Données mises à jour. Continuer ?", vbYesNo) = vbNo Then 'Retour en arrière
[J9] = [J9] - 1
[E5] = "BL N° " & [J9]
Exit Sub
End If

Application.ScreenUpdating = False

        
'Modification du 9.06.16
        'Remplissage Feuile Stock
        Dim cherch As Range, sto As Range, mvsto As Range
        On Error Resume Next
        For Each cherch In Range("C20:C53, C83:C116")         'cherch sont les cellules colonne C (Désignation)
            If Not IsEmpty(Range("C20:C53, C83:C116")) Then
            
            Set sto = Feuil24.Columns(3).Find(cherch)   'sto sont les références recherchées dans la feuille Stock
            sto.Offset(0, 5) = sto.Offset(0, 5) + cherch.Offset(0, 2).Value
            'sto.Offset(0, 10) = cherch.Offset(0, 5).Value
            End If
        'Next
    
    'Remplissage Feuile Mvts Stock
           ' For Each cherch In Range("C20:C53, C83:C116")
            If Not IsEmpty(Range("C20:C53, C83:C116")) Then
                If IsEmpty(cherch) Then GoTo suite2
                Set mvsto = Feuil3.Columns(5).Find(cherch)  'mvsto sont les références recherchées dans la feuille Produits
                    
                With Feuil29
                .Range("B30000").End(xlUp).Offset(1, 0) = [F5]
                .Range("B30000").End(xlUp).Offset(0, 1) = cherch
                .Range("B30000").End(xlUp).Offset(0, 6) = cherch.Offset(0, 2).Value
                '.Range("B30000").End(xlUp).Offset(0, 18) = cherch.Offset(0, 5).Value
                .Range("B30000").End(xlUp).Offset(0, 2) = mvsto.Offset(0, -1)
                .Range("B30000").End(xlUp).Offset(0, 3) = mvsto.Offset(0, -2)
                .Range("B30000").End(xlUp).Offset(0, 4) = [B12]
                End With
                End If
            Next

suite2:
'Fin de modif
            
'Remplissage de la feuille Etat des commandes
  With Feuil33
  On Error Resume Next
                If cbl.Offset(, 2) = "" Then
                cbl.Offset(, 1) = [F5]
                cbl.Offset(, 2) = [E5]
                End If
                If cbl2.Offset(, 2) = "" Then
                cbl2.Offset(, 1) = [F5]
                cbl.Offset(, 2) = [E5]
                cbl.Offset(, 8) = [M8]
                End If
                If cbl3.Offset(, 10) = "" Then
                cbl3.Offset(, 1) = [F5]
                cbl3.Offset(, 2) = [E5]
                'Numéro de commande bis
                'cbl.Offset(, 4) = [M8]
                End If
                If Feuil30.[H12] = "" Then cbl.Offset(, 14) = "Fini"
                
                If cbl2.Offset(, -2) = "" Then
                cbl2.Offset(, 1) = [F5]
                cbl2.Offset(, 2) = [E5]
                ElseIf cbl2.Offset(, 2) = "" Then
                cbl2.Offset(, 1) = [F5]
                cbl2.Offset(, 2) = [E5]
                ElseIf cbl2.Offset(, 6) = "" Then
                cbl2.Offset(, 5) = [F5]
                cbl2.Offset(, 6) = [E5]
                End If
                
                If Feuil30.[H12] = "" Then cbl2.Offset(, 10) = "Fini"
                If Feuil30.[H12] = "" Then cbl3.Offset(, 6) = "Fini"
                End With
                




'Appeler. Inscription des numéros dans les feuilles BL et Facture
Index_BL



'Enregistrement dans le Classeur de Livraisons-----------------------------------------------------------
'    On Error GoTo fin2
  'Dim nouvonglet As String, c As Range, LePath As String, LeNom As String, fichier As String, Dossier As String, Chemin As String, sh As Shape, n As Name
   nouvonglet = [E5]
   
    Cells.Copy
    On Error Resume Next
    Workbooks("Historique Bons de Livraison Delicacy 2016.xlsx").Activate
    If Err.Number <> 0 Then
    Workbooks.Open ("C:\Users\Largo\Documents\0 Travail\Autre\Delicacy\0 Gestion\Clients\Archives\Historique Bons de Livraison Delicacy 2016.xlsx")
    End If
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = nouvonglet
    ActiveSheet.Paste
    ActiveWindow.Zoom = 80
    'Columns("N:X").Delete
    
    For Each sh In ActiveSheet.Shapes
    sh.Delete
    Next
    For Each n In ActiveWorkbook.Names
           n.Delete
    Next n
    For Each c In ActiveSheet.[A1:P132].SpecialCells(xlCellTypeFormulas, 23)
            c.Value = c.Value
    Next
     ActiveSheet.Columns("J:AF").Delete
    ActiveSheet.[B1].Select
    ActiveWorkbook.Close True



    MsgBox ("Sauvegarde effectuée.")



    'Enregistrement du Pdf----------------------------------------------------------------------------------
If [C83] <> "" Then
Range("B1:H120").Select
Else
Range("B1:H56").Select
End If

With ActiveSheet
    fichier = "\" & Range("B12") & " " & [E5] & " du " & Format([F5], "ddmmyyyy") & ".pdf"
    Dossier = "C:\Users\Largo\Documents\0 Travail\Autre\Delicacy\0 Gestion\Clients\BL"
    Chemin = Dossier & fichier
End With

Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin, _
    Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
Range("I18").Select



Exit Sub



Bltemp: '--------------------------------------------------------------------------------------------------------------------
            'Vérification de l'existance des BL
                If [H8] = "" Then
                On Error Resume Next
                If cbl.Offset(, 9) <> "" Then
                MsgBox ("BL 3 déjà existant !")
                Exit Sub
                End If
                If cbl.Offset(, 6) <> "" Then
                MsgBox ("BL 2 déjà existant !")
                Exit Sub
                End If
                If cbl.Offset(, 2) <> "" Then
                MsgBox ("BL déjà existant !")
                Exit Sub
                End If
                
                Else
                
'Modif
                
                If Application.CountIf([E8], "*ter") Then
                If cbla.Offset(, 6) = "" Then GoTo derbl
                'Else: MsgBox ("BL 3 déjà existant !")
                'Exit Sub
                End If
                'If cbla.Offset(, 2) <> "" Then
                'MsgBox ("BL 2 déjà existant !")
                'Exit Sub
                'Else: GoTo continue
                'End If
End If

                          
'fin modif
                
              If Not cbl2 Is Nothing Then
                If cbl2.Offset(, 6) <> "" Then
                MsgBox ("BL 3 déjà existant !")
                Exit Sub
                End If
                If cbl2.Offset(, 2) <> "" Then
                MsgBox ("BL 2 déjà existant !")
                Exit Sub
                End If
                End If
                
                
derbl:
            'Remplissage coordonnées en feuille BL Temp
                Feuil34.[B12] = [B12]
                Feuil34.[B13] = [B13]
                Feuil34.[B14] = [B14]
                Feuil34.[B15] = [B15]
                Feuil34.[C15] = [C15]
                Feuil34.[G5] = [G5]
                Feuil34.[E8] = [E8]
                Feuil34.[F8] = [F8]
                Feuil34.[G8] = [G8]
                Feuil34.[H8] = [E8]
            ' Numérotation du nouveau BL et de la date
                [J9] = [J9] + 1
                [E5] = "BL N° " & [J9]
                
                Feuil34.[E5] = [E5] & " P"      'P pour Partiel
                Feuil34.[F5] = Date
            
            'Vidage des anciennes commandes colonnes C et K
                Feuil34.Range("C20:E60, K20:M60").ClearContents
            'Remplissage des données du nouveau BL
                Lg = Feuil34.Range("C61").End(xlUp).Row + 1
                If Lg = 19 Then Lg = 20
                Lg2 = Feuil34.Range("K61").End(xlUp).Row + 1
                If Lg2 = 19 Then Lg2 = 20
Dim df As Range
'Modification du 2.06.16
For Each cel In Range("C20:C54, C83:C116")
If IsEmpty(cel) Then GoTo rempstock
 Set stockval = Feuil24.Columns(3).SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Find(cel).Offset(, 6) 'stockval = quantité en feuille stock
Set vali = cel.Offset(, 2) 'quantité en BL
                        If cel.Offset(, -2) = "" And cel <> "" Then
                        Feuil34.Range("C" & Lg) = cel
                          If vali > stockval Then
                          Feuil34.Range("E" & Lg) = vali - stockval
Set df = Feuil34.Range("E" & Lg)
Set valtemp = vali - df
                            Feuil34.Range("K" & Lg2) = cel
                            Feuil34.Range("M" & Lg2) = valtemp
                          Lg2 = Lg2 + 1
                          
                          Else
                          Feuil34.Range("E" & Lg) = vali
                          End If
                          'Feuil31.Range("F" & Lg) = cel.Offset(, -1)
                          Lg = Lg + 1
                        
                        Else
                         If cel.Offset(, -2) <> "" And cel <> "" Then
                            Feuil34.Range("K" & Lg2) = cel
                            Feuil34.Range("M" & Lg2) = cel.Offset(, 2)
                          'Feuil31.Range("F" & Lg) = cel.Offset(, -1)
                          Lg2 = Lg2 + 1
                        End If
                        
                        End If
                
                Next
rempstock:
 

pierrejean

XLDnaute Barbatruc
Re : Déclarations et soustractions de variables

Re

N'apporte malheureusement rien

teste modifier

Set df = Feuil34.Range("E" & Lg)
valtemp = vali - df

en

df = Feuil34.Range("E" & Lg).value
msgbox(vali.value & " " & df)
valtemp = vali.value - df

et dis nous ce que raconte la msgbox
 

Calvus

XLDnaute Barbatruc
Re : Déclarations et soustractions de variables

Re,

La msgbox ne s'affiche même pas !!!! Et df est devenu nothing.
Suis en train de modifier le fichier pour pouvoir l'envoyer.
C'est long...
 

pierrejean

XLDnaute Barbatruc
Re : Déclarations et soustractions de variables

Re

df n'est pas devenu Nothing mais est resté Nothing
Il doit y avoir avant
df = Feuil34.Range("E" & Lg).value
quelque chose qui fait que la macro n'effectue pas cette ligne
 

Calvus

XLDnaute Barbatruc
Re : Déclarations et soustractions de variables

Re,

df est bien devenu.

Voici le fichier sans les modifications apportées après ce fil.

J'ai tout nettoyé je pense, à part la macro concernée.
La macro concerne la feuille BL. Il faut laisser les quantités telles quelles pour activer cette partie du code.

Merci
 

Pièces jointes

  • Variable Forum.xlsm
    578.8 KB · Affichages: 56
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…