Microsoft 365 Code transfert

Marvin57 · 14 Avril 2024

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 · 14 Avril 2024

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

VB:

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...

ChTi160 · 14 Avril 2024

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

Marvin57 · 14 Avril 2024

ChTi160 à dit:
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 · 14 Avril 2024

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

Marvin57 · 14 Avril 2024

ChTi160 à dit:
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 · 14 Avril 2024

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 · 14 Avril 2024

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

VB:

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 · 14 Avril 2024

ChTi160 à dit:
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 · 14 Avril 2024

Salut, une autre suggestion:

VB:

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 · 14 Avril 2024

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

Marvin57 · 14 Avril 2024

ChTi160 à dit:
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 · 14 Avril 2024

Franc58 à dit:

Salut, une autre suggestion:

VB:

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

Microsoft 365 Code transfert

Marvin57

XLDnaute Occasionnel

Pièces jointes

ChTi160

ChTi160

XLDnaute Barbatruc

Marvin57

XLDnaute Occasionnel

ChTi160

XLDnaute Barbatruc

Pièces jointes

Marvin57

XLDnaute Occasionnel

ChTi160

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

Marvin57

XLDnaute Occasionnel

Pièces jointes

Franc58

XLDnaute Occasionnel

ChTi160

XLDnaute Barbatruc

Pièces jointes

Marvin57

XLDnaute Occasionnel

Marvin57

XLDnaute Occasionnel

Discussions similaires