Remplir une case à partir d'un classeur, vers un fermé

[Carnage029]

Bonjour à tous,

En cherchant un peu sur le forum, j'ai trouvé des fils qui parlaient de mon soucis, cependant je n'arrive pas à adapter le code comme je le veux... à chaque fois il y'a des erreurs et j'ai même perdu une demi-journée de travail à cause d'un plantage

Je me permet donc de vous demander de l'aide

Je souhaiterai créer une procédure dans un classeur, qui se lance lorsque l'on clic sur un bouton, (ça je sais faire)

Je vous met en PJ le classeur excel (légèrement modifié pour des raisons de confidentialités) que je souhaite remplir...

Ma procédure à 3 arguments, la date (à afficher au format jj/mm/aaaa) , le n° d'adhérent (chaine de 9 caractères), et le montant (nombre à afficher avec séparateur de milliers et deux chiffres après la virgule)

Dans mon excel les lignes à remplir ne sont que des Remboursements, et les numéros d'adhérents ressemble à 63145DUSD par exemple.

Le but est de :
- Vérifier si la date envoyé par la procédure existe déjà dans la ligne 1, si oui, remplir le montant dans la colonne de cette date, et la ligne du n° d'adhérent ( présents en colonne A, lignes 4,5,12,13,20,21,28,29)
- Si elle n'existe pas, insérer une colonne dans l'ordre chronologique et mettre la date en ligne 1 et le montant pour le numéro d’adhérent correspondant


Voilà j'espère que je me suis fait comprendre

Encore merci


EDIT : Le classeur à partir duquel j'appelle la procédure est dans le même dossier que le classeur Récapitulatif

 

[Compte Supprimé 979]

Re : Remplir une case à partir d'un classeur, vers un fermé

Salut Carnage029

Et ou est ton code en question !?

A+

 

[Carnage029]

Re : Remplir une case à partir d'un classeur, vers un fermé

Je l'ai pas mis, mais pour me faire honte je te le met, il y'a malheureusement encore des erreurs... et je ne sais pas trop comment faire pour fermer le fichier et tout et tout...

Sub maj_recap()

Dim myDa As Date
Dim myNoa As String
Dim myvalu As Single

myDa = Sheets("Balance").Range("C13").Value
myNoa = Sheets("system").Range("S17").Value
myvalu = Sheets("Balance").Range("D8").Value

Call call_recap(myDa, myNoa, myvalu)

End Sub


Sub call_recap(myD As Date, myNo As String, myVal As Single)

Dim fso As Object
Dim itEx As Boolean
Dim I, J, K As Integer

K = 0

'Ouverture du classeur Récapituatif-Remboursement.xlsx'
MyPath = ActiveWorkbook.Path ' On récupère le chemin actuel du classeur '
Set fso = CreateObject("Scripting.FileSystemObject") 'vérifie l'existence du fichier '
    x = fso.FileExists(MyPath & "\Historique-Récapitulatif" & ".xlsx")
    If x = True Then 'si oui, on ouvre ce fichier
        Set Wk = Workbooks.Open(Filename:=ThisWorkbook.Path & "\Historique-Récapitulatif" & ".xlsx")
            Wk.Activate
            Application.Visible = True
        
        ' Trouver la ligne du bon numéro d'adherent "
        ' With Sheets("Récapitulatif").Range("a4:a29")
            Set J = .Find(myNo, LookIn:=xlValues, lookat:=xlWhole).Row
        ' End With
        
        ' Trouver la colonne de la bonne date '
        With Sheets("Récapitulatif")
            While K = 0
                For I = 3 To 16382
                    If Cells(1, I) = myD Then ' On regarde si la date existe, si oui on donne à K le numéro de ligne '
                        K = I
                       Exit For
                    End If
                Next
                If K = 0 Then
                    For I = 3 To 16382
                        If Cells(1, I) = "" Then ' Si la date n'existe pas, on la met dans la premièe case vide
                           Cells(1, I) = myD
                           K = I
                           Exit For
                        End If
                    Next
                End If
            Wend
        End With
        
        MsgBox ("I = " & I & "J = " & J)
        With Sheets("Récapitulatif")
          Cells(J, I) = myVal
        End With
    
    Else: MsgBox " Pas de fichier"
    End If

End Sub

 

[Carnage029]

Re : Remplir une case à partir d'un classeur, vers un fermé

Bon j'ai finalement réussi à mettre à jour, mais je n'arrive pas (et j'ai aucune idée de comment il faut faire) à trier les dates...

Sub maj_recap()

Dim myDa As Date
Dim myNoa As String
Dim myvalu As Single

myDa = Sheets("Balance").Range("C13").Value
myNoa = Sheets("system").Range("S17").Value
myvalu = Sheets("Balance").Range("D8").Value

Call call_recap(myDa, myNoa, myvalu)

End Sub


Sub call_recap(myD As Date, myNo As String, myVal As Single)

Dim fso As Object
Dim itEx As Boolean
Dim I, K As Integer
Dim J As Integer
'Dim celluletrouve As Cell

K = 0

'Ouverture du classeur Récapituatif-Remboursement.xlsx'
MyPath = ActiveWorkbook.Path ' On récupère le chemin actuel du classeur '
Set fso = CreateObject("Scripting.FileSystemObject") 'vérifie l'existence du fichier '
    x = fso.FileExists(MyPath & "\Historique-Récapitulatif" & ".xlsx")
    If x = True Then 'si oui, on ouvre ce fichier
        Set wk = Workbooks.Open(Filename:=ThisWorkbook.Path & "\Historique-Récapitulatif" & ".xlsx")
            wk.Activate
            Application.Visible = True
        
        ' Trouver la ligne du bon numéro d'adherent "
        With Sheets("Récapitulatif")
            
            Set celluletrouve = wk.Sheets("Récapitulatif").Range("a4:a29").Find(myNo, LookIn:=xlValues, lookat:=xlWhole)
    
            J = wk.Sheets("Récapitulatif").Range("a4:a29").Find(myNo, LookIn:=xlValues, lookat:=xlWhole).Row
        
        End With
        ' Trouver la colonne de la bonne date '
        With Sheets("Récapitulatif")
            While K = 0
                For I = 3 To 16382
                    If Cells(1, I) = myD Then ' On regarde si la date existe, si oui on donne à K le numéro de ligne '
                        K = I
                       Exit For
                    End If
                Next
                If K = 0 Then
                    For I = 3 To 16382
                        If Cells(1, I) = "" Then ' Si la date n'existe pas, on la met dans la premièe case vide
                           Cells(1, I) = myD
                           K = I
                           Exit For
                        End If
                    Next
                End If
            Wend
        End With
        
        MsgBox ("I = " & I & "J = " & J)
        With Sheets("Récapitulatif")
          Cells(J, I) = myVal
        End With
    
        
    
        'End With
        Else: MsgBox " Pas de fichier"
    End If
    

    wk.Save
    wk.Close

End Sub

Si quelqu'un à une idée ?

merci encore