Amélioration de code VBA
Bonjour à tous
J'ai besoin d'aide pour l'amélioration de mon programme VBA.
Le code ci-dessous me permet de copier des données à partir d'une feuille nommée "RAPPORT DU JOUR" pour les transférer dans une feuille de ma base de données Excel nommée "CARTON".
Cette mise à jour est effectuée chaque jour.
Ma préoccupation est la suivante :
Est-ce possible de faire la mise à jour en chargeant plusieurs rapports journaliers en même temps ? c'est à dire en un seul click
Si oui, pourriez-vous apporter une modification au code ci-dessous pour l'adapter à mon besoin ?
Respectueusement
CODE VBA POUR SELECTIONNER LE RAPPORT JOURNALIER
Private Sub Chemin1_Click()
End Sub
Private Sub BTN_DRA__Click()
End Sub
Private Sub OuvrirFichier_Click()
Application.StatusBar = "OUVERTURE DU FICHIER " & NomfichierSource & "..."
Btn_OUVRIR_RAPPORT_Click
MsgBox NomfichierSource & " est ouvert ", , "Chemin du Rapport Source"
REPONSE = MsgBox("Le Rapport1 a été Chargé, Actionner le bouton Mise à jour pour collecter les données ", vbOKOnly, "CONFIRMATION1")
LAB_Chemin.Caption = NomfichierSource
End Sub
CODE VBA POUR TRANSFERER LES DONNEES DANS LA BASE
Public SOURCE As Object
Public SORTIE As Object
Public NomfichierSource As Variant
Public Const REFDATE As Date = #12/31/2023#
Public REPONSE As String
Public a, b As Integer
Public M As Integer
Public rep1 As Integer
Public vfeuille As Worksheet
Public Rep As String
Public J As Integer
Public DATEJOUR As Date
Sub Btn_OUVRIR_RAPPORT_Click()
NomfichierSource = Application.GetOpenFilename("Fichier Excel(*.xls), *.xls,Fichier Excel (*.xlsx), *.xlsx")
' On verifie que l'on a selectionné un nom de classeur
If NomfichierSource = "" Then
' On ouvre le classeur en lecture seule
Set SOURCE = Workbooks.Open(NomfichierSource, True, True)
MsgBox NomfichierSource & " est ouvert ", , "Chemin du Rapport Source"
REPONSE = MsgBox("Le Rapport a été Chargé, actionner le bouton DRAP pour collecter les données", vbOKOnly, "CONFIRMATION")
End If
End Sub
Sub BTN_DRAP_Click()
Application.ScreenUpdating = False ' turn off the screen updating
Application.StatusBar = "DRAP" & NomfichierSource & "..."
On Error Resume Next 'ignore errors
' open the source workbook,read only
Set SOURCE = Workbooks.Open(NomfichierSource, True, True)
On Error GoTo 0 ' stop when errors occur
If Not SOURCE Is Nothing Then ' opened the workbook
'GLOBAL DATA
With Feuil1
'la date du rapport source
For a = 1 To 120
If SOURCE.Worksheets("RAPPORT DU JOUR").Cells(2, a).Value = " RAPPORT DU JOUR " Then
DATEJOUR = SOURCE.Worksheets("RAPPORT DU JOUR ").Cells(3, a + 55).Value
End If
Next a
J = DateDiff("d", REFDATE, DATEJOUR)
.Cells(3 + J, 2).Value = DATEJOUR
For a = 1 To 120
If SOURCE.Worksheets("RAPPORT DU JOUR ").Cells(a, 3).Value = " CARTON " Then
.Cells(3 + J, 4).Value = SOURCE.Worksheets("RAPPORT DU JOUR ").Cells(a + 2, 11).Value
.Cells(3 + J, 5).Value = SOURCE.Worksheets("RAPPORT DU JOUR ").Cells(a + 2, 15).Value
.Cells(3 + J, 6).Value = SOURCE.Worksheets("RAPPORT DU JOUR ").Cells(a + 2, 19).Value
.Cells(3 + J, 7).Value = SOURCE.Worksheets("RAPPORT DU JOUR ").Cells(a + 2, 23).Value
.Cells(3 + J, 8).Value = SOURCE.Worksheets("RAPPORT DU JOUR ").Cells(a + 2, 27).Value
End If
Next a
End With
Rep = MsgBox("Mise a jour des données DRAP reussie ", vbOKOnly, "Chargement")
On Error GoTo 0 ' stop when errors occur
SOURCE.Close False ' close the source workbook without saving changes
Set SOURCE = Nothing ' free memory
End If
Application.StatusBar = False ' reset status bar
Application.ScreenUpdating = True ' turn on the screen updating
End Sub
Bonjour,
Quand vous voulez passer un code VBA, utilisez le bouton
