Microsoft 365 Code transfert

[Marvin57]

Bonjour tout le monde,

ci-joint deux fichiers modèles.

Mon souhait et ma demande :

Si j'ouvre le fichier " Marvin57 essai1 " et que j'appelle le formulaire " UserForm1 " via le bouton de l'onglet " ACCUEIL " , je souhaiterai qu'il affiche dans les textbox 2, 3 ,4 et 5 les totaux de la date du jour qui se trouvent dans le fichier " Totaux " sur l'onglet " Totaux sections ". Pour cela il devra certainement ouvrir provisoirement le fichier " Totaux ".

Et lorsque je ferme le formulaire " UserForm1 " il devrait aussi refermer le fichier " Totaux ".

J'espère avoir bien expliqué mon souhait.

Je vous remercie d'avance pour votre aide.

Marvin57

 

[ChTi160]

Bonjour Marvin57
les deux fichiers sont dans le même dossier ?
Jean marie

 

[Marvin57]

Bonjour Marvin57
les deux fichiers sont dans le même dossier ?
Jean marie

Bonjour Jean marie,

oui, j'ai un dossier nommé TRAVAUX et ils se trouvent dans ce dernier

Marvin57

 

[ChTi160]

Re
Une approche (Perfectible)
j'ai transformé le tableau source en Tableau structuré "t_Totaux"!
renommé les TextBox
à voir !
Jean marie

 

[Marvin57]

Re
Une approche (Perfectible)
j'ai transformé le tableau source en Tableau structuré "t_Totaux"!
renommé les TextBox
à voir !
Jean marie

Re,

alors le fonctionnement me convient très bien. Seul point qui me va pas, c'est le tableau structuré !
Je ne peux plus changer cela car c'est compliqué.

Peut-on faire autrement d'après toi ?

 

[ChTi160]

Re
c'est le tableau structuré
si ton fichier Source "Totaux" est le même tout le temps , c'est pas compliqué !
de transformer une plage de cellule en tableau structuré .
me dire le pourquoi du :

Je ne peux plus changer cela car c'est compliqué.

avant de faire autrement Lol
jean marie

 

[ChTi160]

Re
ce que j'ai modifié (si pas de possibilité d'utiliser un Tableau structuré)

Public Function RecupDonnees()

  Dim WkB_Cible As Workbook
    Dim TabTemp() As Variant
    Dim Lgn As Long, Col As Long
    
    ' Chemin d'accès complet du fichier source
    Dim Chemin As String
    Dim Ok_Found As Boolean
    Chemin = ThisWorkbook.Path & "\Totaux.xlsm"
    Application.ScreenUpdating = False
    ' Ouvrir le fichier source en tant que workbook
    Set WkB_Cible = Workbooks.Open(Chemin)
    Ok_Found = False
    'On récupére la plage de données du tableau
    TabTemp = WkB_Cible.Worksheets("Total sections").Range("E6").CurrentRegion.Value '    Range("t_Totaux").ListObject.DataBodyRange.Value
    ' Fermer le fichier source sans enregistrer
    WkB_Cible.Close False
    
    For Lgn = 1 To UBound(TabTemp, 1)
         If TabTemp(Lgn, 1) = Date Then
           With UserForm1
                .TBx_A = TabTemp(Lgn, 2)
                .TBx_B = TabTemp(Lgn, 3)
                .TBx_C = TabTemp(Lgn, 4)
                .TBx_D = TabTemp(Lgn, 5)
                Ok_Found = True
           End With
            
         End If
         If Ok_Found = True Then Exit For
    Next Lgn
    Application.ScreenUpdating = True
End Function

Jean marie

 

[Marvin57]

Re
c'est le tableau structuré
si ton fichier Source "Totaux" est le même tout le temps , c'est pas compliqué !
de transformer une plage de cellule en tableau structuré .
me dire le pourquoi du :

avant de faire autrement Lol
jean marie

Je t'ai fais un copier collé de l'onglet origine. Je l'ai placé sur l'onglet Feuil2

 

[Franc58]

Salut, une autre suggestion:

Private Sub UserForm_Initialize()
    
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim rng As Range
    Dim todayRow As Long
    Dim i As Long
    
    Me.TextBox1.Value = Format(Date, "dd/mm/yyyy")
    Application.ScreenUpdating = False
    
    ' Ouverture classeur "Totaux.xlsm"
    Set wb = Workbooks.Open(ThisWorkbook.Path & "\Totaux.xlsm")
    Set ws = wb.Sheets("Total sections")
    
    ' Parcourir les cellules E7 à E37 pour trouver la date du jour
    For i = 7 To 37
        If ws.Cells(i, "E").Value = Date Then
            todayRow = i
            Exit For
        End If
    Next i
    
    If todayRow > 0 Then
        ' Récupérer les totaux des 4 cellules adjacentes
        TextBox2.Value = ws.Cells(todayRow, "F").Value
        TextBox3.Value = ws.Cells(todayRow, "G").Value
        TextBox4.Value = ws.Cells(todayRow, "H").Value
        TextBox5.Value = ws.Cells(todayRow, "I").Value
    End If
    
End Sub
Private Sub UserForm_Terminate()
    
    ' Fermer le fichier Totaux.xlsm
    Workbooks("Totaux.xlsm").Close SaveChanges:=False
    
End Sub

 

[ChTi160]

Re
comment j'ai modifié le Fichier "Totaux"
y'a aparemment des Liens vers un fichier "Effectif........xlsm"
à voir !
Jean marie

 

[Marvin57]

Re
comment j'ai modifié le Fichier "Totaux"
y'a aparemment des Liens vers un fichier "Effectif........xlsm"
à voir !
Jean marie

Re,

désolé, je m'étais trompé.

Tout fonctionne avec ta seconde proposition dans le post #7. Nickel.

Merci beaucoup Jean marie et à une prochaine certainement.

Bonne fin de week end.

Marvin57

 

[Marvin57]

Salut, une autre suggestion:

Private Sub UserForm_Initialize()
   
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim rng As Range
    Dim todayRow As Long
    Dim i As Long
   
    Me.TextBox1.Value = Format(Date, "dd/mm/yyyy")
    Application.ScreenUpdating = False
   
    ' Ouverture classeur "Totaux.xlsm"
    Set wb = Workbooks.Open(ThisWorkbook.Path & "\Totaux.xlsm")
    Set ws = wb.Sheets("Total sections")
   
    ' Parcourir les cellules E7 à E37 pour trouver la date du jour
    For i = 7 To 37
        If ws.Cells(i, "E").Value = Date Then
            todayRow = i
            Exit For
        End If
    Next i
   
    If todayRow > 0 Then
        ' Récupérer les totaux des 4 cellules adjacentes
        TextBox2.Value = ws.Cells(todayRow, "F").Value
        TextBox3.Value = ws.Cells(todayRow, "G").Value
        TextBox4.Value = ws.Cells(todayRow, "H").Value
        TextBox5.Value = ws.Cells(todayRow, "I").Value
    End If
   
End Sub
Private Sub UserForm_Terminate()
   
    ' Fermer le fichier Totaux.xlsm
    Workbooks("Totaux.xlsm").Close SaveChanges:=False
   
End Sub

Bonjour Franc58,

Merci d'avoir pris le temps pour me faire cette proposition, mais j'avais mis en place celle de Jean marie et cela me convient totalement.

A une prochaine.

Marvin57