Additionner click commandbutton vers textbox

Bonjour,

En choisissant d'ajouter "Date " au nom de la feuille dans "Vue_Globale" ...

Je constate que ce cela pose problème au moment de chercher si la feuille existe ...

Il faut donc corriger aussi à cet endroit aussi ...

Sinon, tout semble bien fonctionner ...

        ' vérifie sur le nom de la nouvelle feuille existe déjà avant de la renommer
    For Each Sh In ActiveWorkbook.Worksheets
        If Sh.Name = "Date " & NomFeuil Then  ' << il fallait aussi corrigé ici
            MsgBox "Ce nom de feuille existe déjà ... veuiller corriger manuellement. "
            Exit Sub
        End If
    Next Sh

        ' renomme la nouvelle feuille
     ActiveSheet.Name = "Date " & NomFeuil

ric

Bonjour Ric,

Merci de l'information, je vais faire la modification.

Bonjour Ric,

Bête petite question au niveau du transfert c: stp

J'ai bien fais toute les modifications que tu m'as dis.

Par facilité ou plutôt pour ne pas tirer la clef usb tous les jours 😊. J'ai mis le fichier vue global en réseau (et ça marche)

Cependant, me suis dis, si jamais il y aurais un problème avec le Wi-Fi et à cause de cela, le transfert ne ce fait pas.

Serait-il possible d'avoir comme solution. Un style si problème WiFi (problème transfert avec le réseau).

Le transfert ce ferais ce une clef usb et la je le ferais manuellement après.

Jespere m'être bien fais comprendre

En te remerciant

Bonjour,

https://excel-malin.com/codes-sources-vba/vba-verifier-si-le-fichier-existe/#:~:text=En%20VBA%2C%20i...ès,fonction%20retourne%20une%20chaîne%20vide.

Il y a ce code qui vérifie si le fichier existe dans le chemin que tu lui indiques ...

Si le WiFi ne fonctionne pas > le fichier ne sera pas trouvé ...

Si suffit dès lors de rediriger sur l'autre chemin ...

ric

Bonjour Ric,

Qu'en penses-tu, ca serais pas mal si je fais une condition si

'd'abord le test si le fichier existe
If Len(Dir(Var_Chemin & FichDest)) = 0 Then 's'il n'existe pas, montrer un avertissement et quitter la macro
MsgBox "ERREUR: Le Classeur: [" & Var_Chemin & FichDest & "] n'existe pas..." (ici je changerais la msgbox par: Problème de Transfert, veuillez sauvegarder sur clef, et en appuyant sur oui, le transfert ce ferais ce la clef et non le fichier premier)
Exit Sub
Else
End If

Tant pense quoi?

Merci

Re,

J'ai essaye avec 2 Module

Le premier c'est avec l'emplacement du réseau ou j'avais mis ce code (si réseau =0 alors msbox pour m'orienter sur la clef)

'd'abord le test si le fichier existe
If Len(Dir(Var_Chemin & FichDest)) = 0 Then 's'il n'existe pas, montrer un avertissement et quitter la macro
If MsgBox("Vous allez être Orienté sur clef USB pour le Transfert", vbYesNo + vbQuestion, "Demande de confirmation") = vbYes Then
Module2.SauvegarderLaJournee2
End If
Exit Sub

Le deuxième module (identique que le premier sauf l'accès du transfert)

Mais marche pas

Bonsoir Ric,

Désolé de t'ennuier mais j'arrive toujours pas à trouver ou placer mon msbox si le premier transfert ne marche pas à cause du réseau.

Pourrais-tu m'aider stp

Un grand merci

Bonjour,

Je regarde cela demain ...

ric

Bonsoir Ric,

Merci

Bonjour,

Len(Dir( .... > te donnera une valeur ...

Un essai ...

Sub LeTransfert()
Dim Message As Integer
Dim Var_Chemin As String
Dim FichDest As String

    If Len(Var_Chemin & FichDest) = 0 Then

        's'il n'existe pas, montrer un avertissement et quitter la macro
        Message = MsgBox(" Problème de Transfert, veuillez sauvegarder sur clef," _
                         & Chr(10) & " en appuyant sur oui, le transfert se fera sur la clef," _
                         & Chr(10) & " en appuyant sur non, le transfert se fera sur le fichier premier.", vbQuestion + vbYesNo + vbDefaultButton2, " Problème de sauvegarde ... ")

        If Message = vbYes Then
            MsgBox "Yes"
        Else
            MsgBox "No"
        End If
    End If
End Sub

ric

Bonsoir Ric,

Un grand merci de ton temps

Je crois que je vais réessayer demain car soit il est trop tard ou je suis trop c.....

Mais j'arrive pas pfffff

J'ai compris ton code comme cela:

il recherche le chemin principal donc le chemin réseau

si problème avec le réseau, la msgbox s'affiche et en sélectionnant oui au lieu de sauvegarder dans le répertoire réseau, il sélectionne la clef

donc dans Message = vbyes (j'ai supprimer MsgBox "Yes" et j'y ai mis l'accès au répertoire D:\

Au pire j'ai pas besoin du bouton non car si il ne sauvegarde pas dans le répertoire réseau automatiquement après détection et avoir dis oui pour la clef, il sauvegardera sur la clef

Dim Message As Integer
Dim Var_Chemin As String
Dim FichDest As String

If Len(Var_Chemin & FichDest) = 0 Then

's'il n'existe pas, montrer un avertissement et quitter la macro
Message = MsgBox(" Problème de Transfert, veuillez sauvegarder sur clef," _
& Chr(10) & " en appuyant sur oui, le transfert ce feras sur la clef," _
& Chr(10) & " en appuyant sur non, le transfert ce feras sur le fichier premier.", vbQuestion + vbYesNo + vbDefaultButton2, " Problème de sauvegarde ... ")

If Message = vbYes Then
MsgBox "Yes"
Else
MsgBox "No"
End If
End If

Bonjour Ric,

Je crois avoir compris ce que tu m'explique mais c'est la première fois que je calle avec tes informations.

J'ai passé toute la nuit et la journée et j'arrive toujours pas.

Pourtant suis sur que je suis pas loin

😢

Bonjour,

Désolé pour le délai > j'avais autre chose sur le feu ...

Voici et testé >

Si réseau n'est pas accessible > demande vers la clé > oui = sauvegarde sur la clé > non = sauvegarde dans le même dossier que le fichier ...

J'ai eu des réponses > clé non accessible > puis, après quelques essais > ça s'est mis à fonctionner ...

Private Sub CommandButton1_Click()
Dim Message As Integer
Dim CheminR As String   ' < chemin réseau
Dim CheminC As String   ' < chemin Clé USB
Dim FichDest As String  ' < nom du fichier en cours
Dim i

    FichDest = ActiveWorkbook.Name
    CheminR = "\\MonServeur\SauvexFlox\"    ' << ton chemin réseau et le nom du dossier de sauvegarde

    On Error Resume Next
    i = Dir(CheminR & "*.*")

    If i = "" Then      ' < si le chemin réseau n'est pas accessible
    on error goto 0
        's'il n'existe pas, montrer un avertissement et quitter la macro
        Message = MsgBox(" Problème de Transfert, veuillez sauvegarder sur clef," _
                         & Chr(10) & " en appuyant sur oui, le transfert se fera sur la clef," _
                         & Chr(10) & " en appuyant sur non, le transfert se fera sur le fichier premier.", vbQuestion + vbYesNo + vbDefaultButton1, " Problème de sauvegarde ... ")

        If Message = vbYes Then         ' < l'on répond OUI
            CheminC = "S:\SauvexFlox\"     ' < nouveau chemin (clé)

            On Error Resume Next
            i = Dir(CheminC & "*.*")

            If i = "" Then
                on error goto 0 
                MsgBox " La clé USB n'est pas accessible !"
                ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "Sauvegarde_" & FichDest
                MsgBox " Copie de sauvegarde dans le même dossier que ce fichier !"

            Else
                ' si la clé est accessible
                ActiveWorkbook.SaveCopyAs CheminC & "Sauvegarde_" & FichDest
                MsgBox " Sauvegarde effectuée sur la clé !"
            End If
        ElseIf Message = vbNo Then
            GoTo FIN
        End If

    Else
        ' si le chemin réseau  est accessible
        ActiveWorkbook.SaveCopyAs CheminR & "Sauvegarde_" & FichDest
        MsgBox " Sauvegarde effectuée sur le chemin réseau !"
    End If
FIN:
    On Error GoTo 0
End Sub

Public Function DossierExiste(MonDossier As String)
'par Excel-Malin.com ( https://excel-malin.com )

   If Len(Dir(MonDossier, vbDirectory)) > 0 Then
      DossierExiste = True
   Else
      DossierExiste = False
   End If
End Function

ric

Bonsoir Ric,

Je te remercie mille fois de ton aide (tous d'abors, pardon, tu n'as vraiment pas à t'excusé, c'est déjà super sympa de prendre de ton temps mon pour moi)

Voilà ce que j'ai fais et ça l'aire de fonctionner super grace à toi

Private Sub CommandButton1_Click()
Dim Message As Integer
Dim CheminR As String ' < chemin réseau
Dim CheminC As String ' < chemin Clé USB
Dim FichDest As String ' < nom du fichier en cours
Dim i

FichDest = ActiveWorkbook.Name
CheminR = "\\FILEHUB\UsbDisk1_Volume1\xFlox\Vue-globale.xlsm" ' << ton chemin réseau et le nom du dossier de sauvegarde

On Error Resume Next
i = Dir(CheminR & "*.*")

If i = "" Then ' < si le chemin réseau n'est pas accessible
On Error GoTo 0
's'il n'existe pas, montrer un avertissement et quitter la macro
Message = MsgBox(" Problème de Transfert, veuillez sauvegarder sur clef," _
& Chr(10) & " en appuyant sur oui, le transfert se fera sur la clef," _
& Chr(10) & " en appuyant sur non, le transfert se fera sur le fichier premier.", vbQuestion + vbYesNo + vbDefaultButton1, " Problème de sauvegarde ... ")

If Message = vbYes Then ' < l'on répond OUI
CheminC = "D:\Vue-globale.xlsm" ' < nouveau chemin (clé)

On Error Resume Next
i = Dir(CheminC & "*.*")

If i = "" Then
On Error GoTo 0
MsgBox " La clé USB n'est pas accessible !"
ActiveWorkbook.SaveCopyAs ThisWorkbook.Path & "Sauvegarde_" & FichDest
MsgBox " Copie de sauvegarde dans le même dossier que ce fichier !"

Else
' si la clé est accessible
ActiveWorkbook.SaveCopyAs CheminC
MsgBox " Sauvegarde effectuée sur la clé !"
End If
ElseIf Message = vbNo Then
GoTo FIN
End If

Else
' si le chemin réseau est accessible
ActiveWorkbook.SaveCopyAs CheminR
MsgBox " Sauvegarde effectuée sur le chemin réseau !"
End If
FIN:
On Error GoTo 0
End Sub

Public Function DossierExiste(MonDossier As String)
'par Excel-Malin.com ( https://excel-malin.com )

If Len(Dir(MonDossier, vbDirectory)) > 0 Then
DossierExiste = True
Else
DossierExiste = False
End If
End Function

Pourrais tu me dire ou est ce que dois placer le code (je suppose que c'est celui-ci) pour ajouter mes transferts dans le fichier vue-globale après journée et remplacer l'onglet par la date du transfert

Sub SauvegarderLaJournee()
Dim FichSource As String
Dim NomFeuil As String
Dim oCtrl As Shape
Dim Sh As Worksheet

VarTest = False ' << servira plus loin si Vue_Globale déjà ouvert ou pas

'' '' "C:\xflox\Vue_globale.xlsm"
Var_Chemin = "C:\xFlox\"
FichDest = "Vue-globale.xlsm"

FichSource = ActiveWorkbook.Name ' < ce classeur ci

' mémorie le nom de la feuille pour le classeur Vue_globale
NomFeuil = Workbooks(FichSource).Sheets("Journée").Range("A1").Value

' remplace les caractères incompatible quand l'on renomme automatiquement la feuille dans Vue_Globale
NomFeuil = Replace(NomFeuil, "-", "_")

' teste si vue_globale est déjà ouvert
Call ExempleTestOuvertureClasseur

' si pas ouvert
If VarTest = False Then
Workbooks.Open Var_Chemin & FichDest, 0, ReadOnly:=False
Else
' si déjà ouvert en arrière plan
Workbooks(FichDest).Activate
End If

' coppie le feuille dans Vue_Globale
Workbooks(FichSource).Sheets("Journée").Copy after:=Workbooks(FichDest).Sheets("Globale")


' vérifie sur le nom de la nouvelle feuille existe déjà avant de la renommer
For Each Sh In ActiveWorkbook.Worksheets
If Sh.Name = "Date " & NomFeuil Then ' << il fallait aussi corrigé ici
MsgBox "Ce nom de feuille existe déjà ... veuiller corriger manuellement. "
Exit Sub
End If
Next Sh

' renomme la nouvelle feuille
ActiveSheet.Name = "Date " & NomFeuil

' remplace la formule par la valeur

ActiveSheet.Range("A1") = NomFeuil

' supprime le bouton devenu inutile dans la nouvelle feuille du fichier Vue_Globale
For Each oCtrl In ActiveSheet.Shapes
oCtrl.Delete
Next oCtrl

' << il ne reste qu'à cumuler les donnnées de la nouvelle feuille
' << dans la feuille Globale du fichier Vue_Globale
' << Ajouter la date du cuml au cas ou il y aurait double cumul d'une journée

End Sub

J'espère m'être bien fais comprendre

Encore mille merci de ton aide

Bonjour,

Pourrais tu me dire ou est ce que dois placer le code (je suppose que c'est celui-ci) pour ajouter mes transferts dans le fichier vue-globale après journée et remplacer l'onglet par la date du transfert

Je vais tenter de terminer mon projet > ensuite, tu n'as pas réussi > je t'aiderai > laisse moi quelques jours.

ric

Bonjour Ric,

Je te remercie.

Bon courage pour ton projet.

Encore merci

Bonjour,

Voici un essai de sauvegarde de la feuille journalière sur 3 chemins en cascade > Réseau > Clé USB > ou dans le même dossier que le fichier de travail ...

Si le réseau n'est pas accessible > ici, j'ai un délai de 20 secondes avant que l'option de la Clé se présente > mais, ça fonctionne ...

Le fichier dans lequel les feuilles journalières sont sauvegardées sur l'un des 3 chemins (Vue-globale.xlsm) doit contenir une feuille (Globale) > sinon, pas de sauvegarde ...

Si la feuille à sauvegarder existe déjà dans le fichier (Vue-globale.xlsm) > un message demandera s'il faut la supprimer pour la remplacer ...

Ce n'est qu'une ébauche grossière qui aura sûrement besoin d'amélioration > c'est son l'utilisation qui en fera foi ...

ric

Bonjour Ric

Un grand merci pour ta rapidité.

J'ai pas encore regardé le code pour bien le comprendre car je suis toujours au travail.

Cependant, j'ai déjà fais quelque test:

1) Concernant le réseau:

Tous m'a l'aire de marcher.

Après le transfert, sauvegarde bien comme demandé après onglet globale dans le fichier vue-globale

2) Clef

J'ai pas encore essayé

3) Sauvegarde dans mes fichiers

Ça l'aire de marché

- Cependant, le fichier à la base s'appelle journée et pour que sa marche, j'ai du le renommée vue-globale (ça serais bien qu'il reste nommé journée ou autre mais pas vue-globale)

- Après la sauvegarde, il coupe tous et me mes le fichier excel tous en bleu et suis obligé de le redémarrer

Voila ce que je constate pour le moment

En te remerciant

Bonjour,

Le fichier source et le fichier cible peuvent porter n'importe quel nom. Il suffit d'adapter le code > pour le faire rapidement CTRL+H > mais le faire une occurrence à la fois pour s'assurer de ne renommer que le nécessaire ...

Il serait aussi possible que le nom du fichier cible ainsi que les chemins réseau et clé USB soient écrits dans une feuille et que des variables lisent ces infos ...

Ainsi, il n'y aurait plus besoin de modifier le code > seulement les infos dans la feuille en question ...

Je ne comprends pas que ça plante à la fin et que tu doives fermer et rouvrir le fichier ...

J'avais un peu oublié que tu utilises Excel 2007 > je vais faire des tests sous cette version ...

Je te reviens ...

ric

Bonjour,

Je te remercie