Pb de Copier une valeur mais colle en texte ?

Le 31/08/2016 à 19:03

Bonjour,

J'ai créée une macro pour sauvegarder les données du ticket de caisse en faisant du copier coller d'une feuille a une autre.

Bien sûr je copie des valeurs et je veux coller des valeur, le problème c'est que sur certaine valeur il me colle du format texte dans la Collone F de l'onglet "Sortie" ????

ICI :

            .Range("F" & xdlgn + i) = xlgnprod(i, 4)  'prix

Voici le code :

Sub Enregistrer_Manu()

    Dim xheurejour As Date, plage As String
    Dim xdlgn As Integer, derl As Integer, i As Integer, l As Integer
    Dim xlgnprod() As String
    Dim xtableau() As Single, xtl As Single
    Dim xreglt As String

    With Sheets("Ticket")
        xheurejour = Sheets("Ticket").Cells(6, 6).Value
        derl = .Range("A500").End(xlUp).Row
        xdlgn = .Range("A" & derl - 9).End(xlUp).Row
        ReDim xlgnprod(1 To xdlgn - 7, 1 To 4)
        For l = 8 To xdlgn
            xlgnprod(l - 7, 1) = .Cells(l, 1).Value    'art
            xlgnprod(l - 7, 2) = .Cells(l, 4).Value    'ref
            xlgnprod(l - 7, 3) = .Cells(l, 5).Value    'q
            xlgnprod(l - 7, 4) = .Cells(l, 6).Value    'prix
        Next l
        xtl = .Cells(derl - 8, 6).Value 'type réglement
        xreglt = .Cells(derl - 7, 3).Value 'Total réglement

    End With

    With Sheets("Ticket")
        plage = .Range("A1:G" & derl).Address
        With .PageSetup
            .PrintArea = plage
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = 1
        End With
        .PageSetup.CenterHorizontally = True
        .PageSetup.CenterVertically = True
        .PrintOut
    End With

    With Sheets("Sorties")
        xdlgn = .Range("B" & Rows.Count).End(xlUp).Row
        For i = 1 To UBound(xlgnprod, 1)
            .Range("A" & xdlgn + i).Value = xheurejour
            .Range("B" & xdlgn + i).Value = xheurejour
            .Range("C" & xdlgn + i).Value = xlgnprod(i, 1)   'art
            .Range("D" & xdlgn + i).Value = xlgnprod(i, 2)   'ref
            .Range("E" & xdlgn + i).Value = xlgnprod(i, 3)   'q
            .Range("F" & xdlgn + i) = xlgnprod(i, 4)  'prix C'EST ICI LE PB
        Next i

        If Sheets("Ticket").Range("A17").Value <> "" Then 'Partage Marié
            xdlgn = .Range("B" & Rows.Count).End(xlUp).Row + 1
                        .Range("A" & xdlgn).Value = xheurejour
                        .Range("B" & xdlgn).Value = xheurejour
                        .Range("C" & xdlgn).Value = Sheets("Ticket").Range("A17").Value    'art
                        .Range("D" & xdlgn).Value = Sheets("Ticket").Range("D17").Value    'ref
                        .Range("F" & xdlgn).Value = Sheets("Ticket").Range("F17").Value    'prix
        End If
    End With

    With Sheets("Encaissements")
        xdlgn = .Range("A" & Rows.Count).End(xlUp).Row + 1
        .Range("A" & xdlgn).Value = xheurejour
        .Range("B" & xdlgn).Value = xheurejour
        .Range("C" & xdlgn).Value = xreglt
        .Range("D" & xdlgn).Value = xtl
    End With

End Sub

Pouvais vous me dire pourquoi il me colle les valeur en Texte ?

Merci d'avance.

Cordialement.

Choco

Le 31/08/2016 à 21:02

Bonsoir,

Le code sans le support fichier ne sert pas pour faire le test.

Le 31/08/2016 à 21:12

Bonsoir,

bien le code c'est vraiment plus clair .. pas besoin de télécharger un fichier pour comprendre...

essai :

.Range("F" & xdlgn + i) =CDec( xlgnprod(i, 4))  'prix C'EST ICI LE PB
Le 31/08/2016 à 21:16

Re,

pierre.jy,

Si tu comprends très bien la demande, réponds au demandeur, ne commence pas à critiquer les autres qui sont moins intelligent que toi. Ne soit pas désagréable. Ici c'est un forum.

Le 31/08/2016 à 23:20

bonsoir

selectionner la colonne F et mettez la en format "standarD" puis relancer la macro

Le 01/09/2016 à 13:41
pierre.jy a écrit :

Bonsoir,

bien le code c'est vraiment plus clair .. pas besoin de télécharger un fichier pour comprendre...

essai :

.Range("F" & xdlgn + i) =CDec( xlgnprod(i, 4))  'prix C'EST ICI LE PB

Merci de votre réponse.

Mais cela fonction pour les premières lignes du ticket, mais à la troisième ligne j'ai une erreur qui apparait :

Erreur d'exécution '13':

Incompatibilité de type

Je trouve cela bizzard car les formats de cellule sont les mêmes " Nombres ".

J'ai même testé avec CDbl:

.Range("F" & xdlgn + i) =CDbl( xlgnprod(i, 4))  'prix C'EST ICI LE PB

Cordialement.

Le 01/09/2016 à 14:47

Bonjour,

Je viens de trouver mon problème, c'est que dans certaine ligne du ticket il y avait des cellule Vide et cela faisait planté la macro.

J'ai donc rajouté la fonction IF pour sauter les ligne Vide

Voici le Code qui fonctionne.

Merci encore pour votre aide 

Sub Enregistrer_Manu()

    Dim xheurejour As Date, plage As String
    Dim xdlgn As Integer, derl As Integer, i As Integer, l As Integer, y As Integer
    Dim xlgnprod() As String
    Dim xtableau() As Single, xtl As Single
    Dim xreglt As String

    With Sheets("Ticket")
        xheurejour = Sheets("Ticket").Cells(6, 6).Value
        derl = .Range("A500").End(xlUp).Row
        xdlgn = .Range("A" & derl - 9).End(xlUp).Row
        ReDim xlgnprod(1 To xdlgn - 7, 1 To 4)
        For l = 8 To xdlgn
            xlgnprod(l - 7, 1) = .Cells(l, 1).Value    'art
            xlgnprod(l - 7, 2) = .Cells(l, 4).Value    'ref
            xlgnprod(l - 7, 3) = .Cells(l, 5).Value    'q
            xlgnprod(l - 7, 4) = .Cells(l, 6).Value    'prix
        Next l
        xtl = .Cells(derl - 8, 6).Value 'type réglement
        xreglt = .Cells(derl - 7, 3).Value 'Total réglement

    End With

    With Sheets("Ticket")
        plage = .Range("A1:G" & derl).Address
        With .PageSetup
            .PrintArea = plage
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = 1
        End With
        .PageSetup.CenterHorizontally = True
        .PageSetup.CenterVertically = True
        .PrintOut
    End With

    With Sheets("Sorties")
        xdlgn = .Range("B" & Rows.Count).End(xlUp).Row
        For y = 8 To xdlgn
        For i = 1 To UBound(xlgnprod, 1)
        If Sheets("Ticket").Range("F" & y).Value = "" Then GoTo 1
            .Range("A" & xdlgn + i).Value = xheurejour
            .Range("B" & xdlgn + i).Value = xheurejour
            .Range("C" & xdlgn + i).Value = (xlgnprod(i, 1))   'art
            .Range("D" & xdlgn + i).Value = CDbl(xlgnprod(i, 2))   'ref
            .Range("E" & xdlgn + i).Value = CDbl(xlgnprod(i, 3))   'q
            .Range("F" & xdlgn + i).Value = CDbl(xlgnprod(i, 4))     'prix
1:
        y = y + 1
        Next i
        Next y

        If Sheets("Ticket").Range("A17").Value <> "" Then 'Partage Marié
            xdlgn = .Range("B" & Rows.Count).End(xlUp).Row + 1
                        .Range("A" & xdlgn).Value = xheurejour
                        .Range("B" & xdlgn).Value = xheurejour
                        .Range("C" & xdlgn).Value = Sheets("Ticket").Range("A17").Value    'art
                        .Range("D" & xdlgn).Value = Sheets("Ticket").Range("D17").Value    'ref
                        .Range("F" & xdlgn).Value = Sheets("Ticket").Range("F17").Value    'prix
        End If
    End With

    With Sheets("Encaissements")
        xdlgn = .Range("A" & Rows.Count).End(xlUp).Row + 1
        .Range("A" & xdlgn).Value = xheurejour
        .Range("B" & xdlgn).Value = xheurejour
        .Range("C" & xdlgn).Value = xreglt
        .Range("D" & xdlgn).Value = xtl
    End With

End Sub
Rechercher des sujets similaires à "copier valeur colle texte"