XL 2013 somme activecell

RomainPOIRET

XLDnaute Occasionnel
Bonjour à tous,

Je souhaite savoir comment additionner des activecells, je m'explique,

J'ai un fichier macro, la macro consiste à fusionner des cellules à l'aide d'un clic droit. Cette fusion renseigne une référence (ex : "A") et une quantité (ex : 3), j'ai un msgbox qui m'indique la référence & la quantité soit "A3";

Lorsque je prend une plage à fusionner + "ctrl" + une autre plage a fusionner, je souhaite que la macro me fasse la somme des quantités soit A3 + A3 soit msg box "A6".
Aujourd'hui quand je le fais j'ai dans me msgbox "A3" ...

Voyez-vous ce que je veux dire ?

Je vous place ci-joint mon fichier, aller directement dans l'onglet "REMPLISSAGE",

Cordialement,

Romain
 

Pièces jointes

  • GENEBOX.v3.xlsm
    126.5 KB · Affichages: 21

Robert

XLDnaute Barbatruc
Repose en paix
Bonsoir Romain, bonsoir le forum,

Je n'ai pas ouvert ton fichier car je n'ai pas bien compris ton énoncé mais...
VBA et les cellules fusionnées ne sont pas de bons amis...
Il n'y a qu'une seule cellule active même si la plage contient plusieurs cellules. Tu ne pourras pas additionner les "Activecell" mais boucler sur plusieurs cellules d'une plage. Par exemple Tu sélectionnes 3 cellules contenant des entiers :

VB:
Dim CEL as Range
Dim T As Integer
For each CEL in Selection
    T = T + CEL.Value
Next CEL
MsgBox T
 
Bonjour Romain, Robert, le forum

pas sur d'avoir bien compris mais cette modif te conviendra peut être.

Bien cordialement
VB:
Private Sub nb_ref_Change()

Application.ScreenUpdating = False

'déclaration de la variable "résultat"
Dim resultat, danger As Variant
danger = Application.VLookup(Me.nb_ref.Value, Sheets("TEMPLATE_FAC").Range("A2:G27"), 5, False)
resultat = Application.VLookup(Me.nb_ref.Value, Sheets("TEMPLATE_FAC").Range("A2:G27"), 7, False)

'Si la référence est caractérisée comme dangereuse, un message apparait sur le userform4
If danger = "OUI" Then
    dangereux.Visible = True
Else
    dangereux.Visible = False
End If

'si la référence est renseignée, afficher le nombre d'UCs restants
If Me.nb_ref.Value <> "" Then
    part1.Visible = True
    part2.Visible = True
    Me.uc_restant.Caption = resultat
    options.Visible = False
    If resultat <= 0 Then
        uc.Enabled = False
        nb_uc.Enabled = False
        part1.Enabled = False
        uc_restant.Enabled = False
        part2.Enabled = False
    ElseIf resultat > 0 Then
        uc.Enabled = True
        nb_uc.Enabled = True
        part1.Enabled = True
        uc_restant.Enabled = True
        part2.Enabled = True
    End If
   
End If

Me.uc_restant.Caption = WorksheetFunction.VLookup(Me.nb_ref.Value, [tableau_ref], 7, False) 'Modif


Application.ScreenUpdating = True

End Sub
 
tu peux aussi alléger ton code avec des with/end with
et je ne sais pas pourquoi tu utilises des End pour stopper le code alors qu'un Exit sub devrait mieux convenir
VB:
Private Sub ok_bouton_Click()

Application.ScreenUpdating = False

'Déclaration de 2 variables
Dim i As Long
Dim couleur, ean As Variant

couleur = Application.VLookup(Me.nb_ref.Value, Sheets("TEMPLATE_FAC").Range("A1:G27"), 6, False)
ean = Application.VLookup(Me.nb_ref.Value, Sheets("TEMPLATE_FAC").Range("A1:G27"), 3, False)

With Selection
    If nb_ref.Value <> "" Then
        If CSng(uc_restant.Caption) < CSng(nb_uc.Value) Then
            MsgBox "Vous n'avez pas la capacité de mettre tant d'UC / lots !", vbInformation, "Information"
            End
        End If
       
        For i = 2 To 27
            If Sheets("TEMPLATE_FAC").Range("A" & i).Value = nb_ref.Value Then
                Sheets("TEMPLATE_FAC").Range("G" & i).Value = Sheets("TEMPLATE_FAC").Range("G" & i).Value - nb_uc.Value
            End If
        Next i
       
        .Merge
        .Interior.ColorIndex = couleur
        .Value = nb_ref & " " & nb_uc & " " & ean
       
       
    '----------- CODE A VOIR -----------------
    Dim chiffre As Integer
    Dim lettre As String
   
    chiffre = Mid(ActiveCell.Value, 3, 2)
    lettre = Mid(ActiveCell.Value, 1, 1)
   
    MsgBox lettre & " " & chiffre
        End
    End If
    '-----------------------------------------
   
    If confinement.Value = True Then
        With .Borders
            .Weight = xlMedium
            .ColorIndex = 3
        End With
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
    End If
   
    If calagepapier.Value = True Then
        If Me.couleur.Value = "VERTE" Then 'Mise en forme cale verte
            .Merge
            .Interior.ColorIndex = 16
            .Value = "CALE PAPIER" & " " & "(x" & qté_papier.Value & ")"
            .Font.ColorIndex = 4
        ElseIf Me.couleur.Value = "BLEUE" Then 'Mise en forme cale bleue
            .Merge
            .Interior.ColorIndex = 16
            .Value = "CALE PAPIER" & " " & "(x" & qté_papier.Value & ")"
            .Font.ColorIndex = 33
        ElseIf Me.couleur.Value = "ROUGE" Then 'Mise en forme cale rouge
            .Merge
            .Interior.ColorIndex = 16
            .Value = "CALE PAPIER" & " " & "(x" & qté_papier.Value & ")"
            .Font.ColorIndex = 3
        ElseIf Me.couleur.Value = "JAUNE" Then 'Mise en forme cale jaune
            .Merge
            .Interior.ColorIndex = 16
            .Value = "CALE PAPIER" & " " & "(x" & qté_papier.Value & ")"
            .Font.ColorIndex = 27
        ElseIf Me.couleur.Value = "BLANCHE" Then 'Mise en forme cale blanche
            .Merge
            .Interior.ColorIndex = 16
            .Value = "CALE PAPIER" & " " & "(x" & qté_papier.Value & ")"
            .Font.ColorIndex = 2
        End If
    End If
   
    If calagecaisse.Value = True Then
        .Merge
        .Interior.ColorIndex = 16
        .Value = quoi_caisse & " " & "(x" & qté_caisse & ")"
        .Font.ColorIndex = 1
    End If
End With


End

Application.ScreenUpdating = True

End Sub
 
je ne sais pas pourquoi tu utilises des End pour stopper le code

je crois que j'ai compris, plutôt brutal pour fermer le userform

VB:
Private Sub ok_bouton_Click()

Application.ScreenUpdating = False

'Déclaration de 2 variables
Dim i As Long
Dim couleur, ean As Variant

couleur = Application.VLookup(Me.nb_ref.Value, Sheets("TEMPLATE_FAC").Range("A1:G27"), 6, False)
ean = Application.VLookup(Me.nb_ref.Value, Sheets("TEMPLATE_FAC").Range("A1:G27"), 3, False)

With Selection
    If nb_ref.Value <> "" Then
        If CSng(uc_restant.Caption) < CSng(nb_uc.Value) Then
            MsgBox "Vous n'avez pas la capacité de mettre tant d'UC / lots !", vbInformation, "Information"
            GoTo Sortie
        End If
        
        For i = 2 To 27
            If Sheets("TEMPLATE_FAC").Range("A" & i).Value = nb_ref.Value Then
                Sheets("TEMPLATE_FAC").Range("G" & i).Value = Sheets("TEMPLATE_FAC").Range("G" & i).Value - nb_uc.Value
            End If
        Next i
        
        .Merge
        .Interior.ColorIndex = couleur
        .Value = nb_ref & " " & nb_uc & " " & ean
        
        
    '----------- CODE A VOIR -----------------
    Dim chiffre As Integer
    Dim lettre As String
    
    chiffre = Mid(ActiveCell.Value, 3, 2)
    lettre = Mid(ActiveCell.Value, 1, 1)
    
    MsgBox lettre & " " & chiffre
        GoTo Sortie
    End If
    '-----------------------------------------
    
    If confinement.Value = True Then
        With .Borders
            .Weight = xlMedium
            .ColorIndex = 3
        End With
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
    End If
    
    If calagepapier.Value = True Then
        If Me.couleur.Value = "VERTE" Then 'Mise en forme cale verte
            .Merge
            .Interior.ColorIndex = 16
            .Value = "CALE PAPIER" & " " & "(x" & qté_papier.Value & ")"
            .Font.ColorIndex = 4
        ElseIf Me.couleur.Value = "BLEUE" Then 'Mise en forme cale bleue
            .Merge
            .Interior.ColorIndex = 16
            .Value = "CALE PAPIER" & " " & "(x" & qté_papier.Value & ")"
            .Font.ColorIndex = 33
        ElseIf Me.couleur.Value = "ROUGE" Then 'Mise en forme cale rouge
            .Merge
            .Interior.ColorIndex = 16
            .Value = "CALE PAPIER" & " " & "(x" & qté_papier.Value & ")"
            .Font.ColorIndex = 3
        ElseIf Me.couleur.Value = "JAUNE" Then 'Mise en forme cale jaune
            .Merge
            .Interior.ColorIndex = 16
            .Value = "CALE PAPIER" & " " & "(x" & qté_papier.Value & ")"
            .Font.ColorIndex = 27
        ElseIf Me.couleur.Value = "BLANCHE" Then 'Mise en forme cale blanche
            .Merge
            .Interior.ColorIndex = 16
            .Value = "CALE PAPIER" & " " & "(x" & qté_papier.Value & ")"
            .Font.ColorIndex = 2
        End If
    End If
    
    If calagecaisse.Value = True Then
        .Merge
        .Interior.ColorIndex = 16
        .Value = quoi_caisse & " " & "(x" & qté_caisse & ")"
        .Font.ColorIndex = 1
    End If
End With

Sortie:
Unload Me

Application.ScreenUpdating = True

End Sub
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 886
Membres
101 830
dernier inscrit
sonia poulaert