Microsoft 365 Code transfert

Marvin57

XLDnaute Occasionnel
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
 

Pièces jointes

  • Marvin57 Essai1.xlsm
    17.7 KB · Affichages: 2
  • Totaux.xlsm
    10.6 KB · Affichages: 2
Solution
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

XLDnaute Barbatruc
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

XLDnaute Occasionnel
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
 

Pièces jointes

  • Totaux.xlsm
    17.1 KB · Affichages: 1

Franc58

XLDnaute Occasionnel
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
 

Marvin57

XLDnaute Occasionnel
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
 

Discussions similaires

Réponses
9
Affichages
233
Réponses
13
Affichages
243
  • Résolu(e)
Microsoft 365 Code de tri
Réponses
22
Affichages
480
Réponses
11
Affichages
596
Réponses
4
Affichages
331
Réponses
5
Affichages
367
Réponses
3
Affichages
538