Ignorer et ne pas afficher un message d'information

Bonjour à tous,

Je me demandais s'il était possible de ne pas afficher un message d'information et d'ignorer ce message.

J'ai créé une connexion entre fichiers. Cette connexion est rafraîchie toutes les demie-heures.Le problème est quand le fichier dans le lequel le récupère des données, est ouvert, la connexion ne peut pas se faire, et le message suivant apparaît:

capture

Comme ce tableau est envoyé sur un écran à destination de mes collègues, ils se retrouvent souvent face à ce message qui les empêche de voir ce qu'il y a en dessous...

J'aimerai donc que ce message ne s'affiche pas et que le rafraîchissement se fasse un plus tard ou la demie-heure.

Voici le code utilsé:

Public Sub actu()

Dim wks As Worksheet
Dim wkb As Workbook

Set wkb = Workbooks("Visu_générale.xlsm")
Set wks = wkb.Worksheets("Graphique")

wkb.Worksheets("donnée").ListObjects(1).Refresh
wkb.Worksheets("Archives").ListObjects(1).Refresh

Call Module4.tab_blanc(wkb)
Call Module1.dessiner(wkb)

End Sub

End Sub

Si quelqu'un a une idée.

Merci !!!

Jojo la frite

Bonjour,

Essaie avec un :

    Application.DisplayAlerts = False

Cordialement.

Merci, mais malheureusement ça ne marche pas....

Bonsoir jojo,

tu a écrit :

Merci, mais malheureusement ça ne marche pas....

quand j'ai vu la solution donnée par MFerrand, j'm'étais dit qu'ça devait être ça ! mais peut-être n'as-tu pas mis cette instruction au bon endroit ? moi, je l'aurais placée juste avant le 1er .Refresh, ainsi :

Public Sub actu()

  Dim wkb As Workbook
  Dim wks As Worksheet

  Set wkb = Workbooks("Visu_générale.xlsm")
  Set wks = wkb.Worksheets("Graphique")

  Application.DisplayAlerts = False

  wkb.Worksheets("donnée").ListObjects(1).Refresh
  wkb.Worksheets("Archives").ListObjects(1).Refresh

  Application.DisplayAlerts = True

  Module4.tab_blanc wkb
  Module1.dessiner wkb

End Sub

tu avais mis un 2ème « End Sub » en trop, que j'ai enlevé ; et c'est plus naturel de déclarer wkb avant wks.

tu auras aussi noté qu'après les 2 .Refresh, j'ai réactivé les alertes : j'crois qu'c'est plus sûr.


si ça marche comme tu veux, merci d'passer l'sujet en résolu ; sinon, indique plus précisément c'qui va pas :

ton « mais malheureusement ça ne marche pas.... » est bien trop vague pour pouvoir t'aider ! donc :

* si y'a un message d'erreur, quel est le texte exact de ce message d'erreur ?

* si y'a une ligne mise en jaune dans le code VBA, laquelle est-ce ?

* quel résultat as-tu qui est autre que celui attendu ?

mais rassure-toi : t'as pas besoin d'raconter toute ta vie depuis ta plus tendre enfance !

sers-nous plutôt des frites.

dhany

Bonjour,

une fonction qui te permet de savoir si ton classeur est disponible :

Sub Test()
    Dim i As Integer
    i = VerifClasseur("C:\Transfert\Test.xls")
    Select Case i
    Case 0: MsgBox "Classeur fermé."
    Case 53: MsgBox "Fichier introuvable"
    Case 70: MsgBox "Classeur déja ouvert."
    Case Else: MsgBox "Erreur : " & i
    End Select
End Sub

Private Function VerifClasseur(Fichier As String) As Integer
    Dim x As Integer
    On Error Resume Next
    x = FreeFile()
    Open Fichier For Input Lock Read As #x
    Close x
    VerifClasseur = Err.Number
    On Error GoTo 0
End Function

Ton sub Actu pourrait se relancer lui--même x min plus tard (3 si fichier occupé, 30 si libre) avec Ontime (voir l'aide vba avec exemple)

Si tu fais ce choix il faudrait programmer le 1er lancement sur workbook_open, et annuler le prochain (à mémoriser) sur workbook_close

eric

Bonsoir dhany !

La solution que tu m'a proposée donne le même résultat. C'est à dire que la récupération de données sur un autre fichier ne peut pas être faite car ce fichier est ouvert. Ce qui est tout à fait normal....Ce qui me gêne, c'est le message qui apparaît, le même que celui de la capture d'écran, un peu plus haut dans la discussion: "[Data Source Error].Le processus ne peut pas accéder au fichier...."

Je vais maintenant me pencher sur l'idée d'eriiic.

Je vous tiens tous les deux au courant.

(avec ou sans sel, les frites?)

jojo la frite

Encore moi !!!

le code d'eriiic casse la baraque (à frites )

je l'ai adapté à ma façon, qui ne doit pas être la plus propre et la plus efficace, mais ça marche!

ci-dessous le code pour le workbook_open et le workbook_close:

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Call Module2.Stop_Horloge_Visu_Ge

End Sub

Private Sub Workbook_Open()

'ouverture plein écran
Application.DisplayFullScreen = True
ActiveWindow.WindowState = xlMaximized

Call Module2.ligne_actu

End Sub

et le code pour tester si mes 3 fichiers sont ouverts ou pas:

'pour actualier le tableau
'ici, on doit faire des changemnt si on change les dimensions du diagramme
Public Sub ligne_actu()

    Dim wkb As Workbook
    Dim wks As Worksheet
    Dim start As Integer
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer
    Dim l As Integer

    Set wkb = Workbooks("Visu_générale.xlsm")
    Set wks = wkb.Worksheets("Graphique")

    'Pour éviter le message d'erreur, on vérifie q'un des 3 fichiers charges_planifiée n'est pas ouvert
    j = VerifClasseur("C:\Users\kaspa\Desktop\gestion fours\Sections_séparées\Charges_Planifiées_Sections_Séparées\charge_planifiée1.xlsm")
    Select Case j
    Case 0
        GoTo suite
    Case 53: MsgBox "Fichier introuvable"
    Case 70
        GoTo fin
    Case Else: MsgBox "Erreur : " & i
    End Select

suite:
    k = VerifClasseur("C:\Users\kaspa\Desktop\gestion fours\Sections_séparées\Charges_Planifiées_Sections_Séparées\charge_planifiée2.xlsm")
    Select Case k
    Case 0
        GoTo suite2
    Case 53: MsgBox "Fichier introuvable"
    Case 70
        GoTo fin
    Case Else: MsgBox "Erreur : " & i
    End Select

suite2:
    l = VerifClasseur("C:\Users\kaspa\Desktop\gestion fours\Sections_séparées\Charges_Planifiées_Sections_Séparées\charge_planifiée3.xlsm")
    Select Case l
    Case 0
        GoTo rafraichissement
    Case 53: MsgBox "Fichier introuvable"
    Case 70
        GoTo fin
    Case Else: MsgBox "Erreur : " & k
    End Select

rafraichissement:

    start = 0

    wkb.Worksheets("donnée").ListObjects(1).Refresh
    wkb.Worksheets("Archives").ListObjects(1).Refresh

    Call Module4.tab_blanc(wkb)
    Call Module1.dessiner(wkb)

    ' Trouver la ligne du départ
    For i = 5 To 29

        If wks.Cells(3, i).Borders(xlEdgeRight).Weight = xlThick Then
            start = i
        End If

    Next i

    ' supprimer la ligne

    If start <> 29 And start <> 0 Then

        With wks
            .Range(.Cells(3, start), .Cells(59, start)).Borders(xlEdgeRight).LineStyle = xlNone
        End With
    ElseIf start = 0 Then GoTo dessiner
    Else
        With wks
            .Range(.Cells(3, start), .Cells(59, start)).Borders(xlEdgeRight).Weight = xlThin
        End With

    End If
    ' dessiner la ligne actuelle

dessiner:

    start = Hour(Now())
    start = start + 5
    With wks
        .Range(.Cells(3, start), .Cells(58, start)).Borders(xlEdgeRight).LineStyle = xlContinuous
        .Range(.Cells(3, start), .Cells(58, start)).Borders(xlEdgeRight).Weight = xlThick
        .Range(.Cells(3, start), .Cells(58, start)).Borders(xlEdgeRight).Color = RGB(255, 0, 0)
    End With

fin:

    Call Module2.Horloge_Visu_Ge

End Sub
Public Sub Horloge_Visu_Ge()
    Dim min As Integer
    Dim nexttime As Variant
    min = (Minute(Now))
    nexttime = Date + TimeSerial(Hour(Now), Minute(Now) + 20, 0)
    If Hour(nexttime) = 0 And Minute(Now) = 0 Then nexttime = nexttime + TimeSerial(0, 1, 0)

    Application.OnTime EarliestTime:=nexttime, Procedure:="ligne_actu", LatestTime:=nexttime + TimeSerial(0, 2, 0)

End Sub
Public Sub Stop_Horloge_Visu_Ge()

    On Error Resume Next
    Application.OnTime EarliestTime:=TimeValue(nexttime), Procedure:="ligne_actu", Schedule:=False

End Sub

Public Sub actu()

    Dim wkb As Workbook
    Dim wks As Worksheet
    Dim j As Integer
    Dim k As Integer
    Dim l As Integer

    Set wkb = Workbooks("Visu_générale.xlsm")
    Set wks = wkb.Worksheets("Graphique")

    'Pour éviter le message d'erreur, on vérifie q'un des 3 fichiers charges_planifiée n'est pas ouvert
    j = VerifClasseur("C:\Users\kaspa\Desktop\gestion fours\Sections_séparées\Charges_Planifiées_Sections_Séparées\charge_planifiée1.xlsm")
    Select Case j
    Case 0
        GoTo suite
    Case 53: MsgBox "Fichier introuvable"
    Case 70
        GoTo fin
    Case Else: MsgBox "Erreur : " & i
    End Select

suite:
    k = VerifClasseur("C:\Users\kaspa\Desktop\gestion fours\Sections_séparées\Charges_Planifiées_Sections_Séparées\charge_planifiée2.xlsm")
    Select Case k
    Case 0
        GoTo suite2
    Case 53: MsgBox "Fichier introuvable"
    Case 70
        GoTo fin
    Case Else: MsgBox "Erreur : " & i
    End Select

suite2:
    l = VerifClasseur("C:\Users\kaspa\Desktop\gestion fours\Sections_séparées\Charges_Planifiées_Sections_Séparées\charge_planifiée3.xlsm")
    Select Case l
    Case 0
        GoTo rafraichissement
    Case 53: MsgBox "Fichier introuvable"
    Case 70
        GoTo fin
    Case Else: MsgBox "Erreur : " & k
    End Select

rafraichissement:

    wkb.Worksheets("donnée").ListObjects(1).Refresh
    wkb.Worksheets("Archives").ListObjects(1).Refresh

    Module4.tab_blanc wkb
    Module1.dessiner wkb

fin:

End Sub

Private Function VerifClasseur(Fichier As String) As Integer
    Dim x As Integer
    On Error Resume Next
    x = FreeFile()
    Open Fichier For Input Lock Read As #x
    Close x
    VerifClasseur = Err.Number
    On Error GoTo 0
End Function

Merci eriiic, merci dhany, encore une fois le forum m'a rendu bien service !

bonne nuit.

jojo la frite

Bonjour,

Heuuuu, tu as fait n'importe quoi là...

Etonné même que ça fonctionne comme tu l'entends

eric

Bonjour eriiic,

Étonnamment, ça marche.

La sub" ligne actu" se déclenche automatiquement à l'ouverture du classeur. Les données sont mises à jour ( via power query) et un tableau est rafraîchi.

Si au moins 1 des 3 fichiers sur lesquels les données sont récupérées, est ouvert, la mise à jour des données ne se fait pas. Elle sera retentée 20 minutes plus tard.

La sub "actu" est appelée par un command button.

Pareil: Si au moins 1 des 3 fichiers sur lesquels les données sont récupérées, est ouvert, la mise à jour des données ne se fait pas.

Je n'ai pas besoin qu'un message soit affiché si un des 3 fichiers est ouvert. Je vais quand même en ajouter un pour avertir l'utilisateur qui tentera une mise à jour manuelle du tableau (sub actu).

Effectivement, j'imagine que j'ai fait n'importe quoi, mais je n'ai pas réussi à faire mieux, vu mon manque d'expérience en VBA.

Je ne savais pas comment faire pour ne pas devoir indiquer les 3 chemins d'accès ( qui sont dans le même dossier). Je n'ai trouvé que cette solution pour que leur ouverture soit testée. Et cela dans les 2 sub, " ligne actu" et "actu".

Maintenant, je suis toujours preneur pour une version plus pro, et donc enrichir mes connaissances en VBA.

Merci.

Jojo la frite

Tu n'as pas besoin de répéter x fois le select case, un seul fichier ouvert suffit à dire niet.

Ou bien, si tu veux garder tes j=..., k=..., l=... tu les fais tous à la suite,

et un If j OR k OR l Then te dit si tu es non ok ou ok, avec un seul traitement pour chaque cas.

Il faut traiter toutes les anos. Sinon si un fichier a disparu, tu entreras dans une boucle sans fin => plantage.

Les Goto rendent le code très difficile à maintenir.

VBA a toutes les structures permettant de s'en passer (presque tout le temps), à utiliser seulement pour les traitements d'erreur.

J'imaginais plus les choses comme ça :

' ThisWorkbook
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Stop_Horloge_Visu_Ge
End Sub

Private Sub Workbook_Open()
    supervise
End Sub

' module Standard
Dim nexttime As Date

Sub supervise()
    Dim i As Integer
    Stop_Horloge_Visu_Ge
    'Pour éviter le message d'erreur, on vérifie q'un des 3 fichiers charges_planifiée n'est pas ouvert
    For i = 1 To 3
        Select Case VerifClasseur("C:\Users\kaspa\Desktop\gestion fours\Sections_séparées\Charges_Planifiées_Sections_Séparées\charge_planifiée" & i & ".xlsm")
        Case 0    ' Classeur fermé.
        Case 70    ' Classeur ouvert
            nexttime = Now + TimeValue("0:02")
            Application.OnTime EarliestTime:=nexttime, Procedure:="supervise"
            Exit Sub
        Case Else:    ' autre Erreur
            MsgBox "Anomalie fichier 'charge_planifiée" & i & ".xlsm'"
            Exit Sub
        End Select
    Next i
    ' fichiers ok
    actu
    nexttime = Now + TimeValue("0:30")
    Application.OnTime EarliestTime:=nexttime, Procedure:="supervise"
End Sub

Public Sub Stop_Horloge_Visu_Ge()
    On Error Resume Next
    Application.OnTime EarliestTime:=nexttime, Procedure:="supervise", Schedule:=False
End Sub

Private Function VerifClasseur(Fichier As String) As Integer
    Dim x As Integer
    On Error Resume Next
    x = FreeFile()
    Open Fichier For Input Lock Read As #x
    Close x
    VerifClasseur = Err.Number
    On Error GoTo 0
End Function

Sub actu()
 '...
End Sub

Et pour un lancement manuel tu appelles supervise. (d'où le Stop_Horloge_Visu_Ge au début, pour ne pas en avoir 15 en attente).

A faire également après une anomalie autre que 'fichier ouvert' pour relancer le bouzin.

Bien sûr je n'ai pas pu tester. Malgré une relecture attentive il reste peut-être des erreurs...

eric

Merci eriiic,

Je regarde dans l'après-midi ou la soirée. Je ne suis pas chez moi.

J'ai hâte d'essayer ton code.

A plus tard !

Bonsoir eriiic,

j'ai testé ton code, c'est parfait/ pas d'erreur.

J'ai juste intégrer le code de la sub actu à la sub supervise.

voici donc le code/

Private Sub Workbook_BeforeClose(Cancel As Boolean)

'ouverture plein écran
    Application.DisplayFullScreen = True
    ActiveWindow.WindowState = xlMaximized

    Call Module2.Stop_Horloge_Visu_Ge

End Sub

Private Sub Workbook_Open()

    Call Module2.supervise

End Sub
Dim nexttime As Date
'rafraichissement du tableau après vérification de la fermeture des fichiers "charge_planifiée" et récupération des données
Sub supervise()

    Dim wkb As Workbook
    Dim wks As Worksheet
    Dim i As Integer

    Set wkb = Workbooks("Visu_générale.xlsm")
    Set wks = wkb.Worksheets("Graphique")

    Call Stop_Horloge_Visu_Ge
    'Pour éviter le message d'erreur, on vérifie q'un des 3 fichiers charges_planifiée n'est pas ouvert
    For i = 1 To 3
        Select Case VerifClasseur("C:\Users\kaspa\Desktop\gestion fours\Sections_séparées\Charges_Planifiées_Sections_Séparées\charge_planifiée" & i & ".xlsm")
        Case 0    ' Classeur fermé.
        Case 70    ' Classeur ouvert
            nexttime = Now + TimeValue("0:04:00") 'si classeur ouvert, nouvelle tentative de rafraichissement dans 4 minutes
            Application.OnTime EarliestTime:=nexttime, Procedure:="supervise"
            Workbooks("Visu_générale.xlsm").Worksheets("Graphique").Range("S66").Value = nexttime
            Exit Sub
        Case Else:    ' autre Erreur
            MsgBox "Anomalie fichier 'charge_planifiée" & i & ".xlsm'"
            Exit Sub
        End Select
    Next i
    ' fichiers ok
    nexttime = Now + TimeValue("0:20:00") 'si classeur fermé, prochain rafraichissement prévu dans 20 minutes
    Application.OnTime EarliestTime:=nexttime, Procedure:="supervise"
    Workbooks("Visu_générale.xlsm").Worksheets("Graphique").Range("S66").Value = nexttime

    wkb.Worksheets("donnée").ListObjects(1).Refresh
    wkb.Worksheets("Archives").ListObjects(1).Refresh

    Module4.tab_blanc wkb
    Module1.dessiner wkb

' Trouver la ligne du départ
For i = 5 To 29

    If wks.Cells(3, i).Borders(xlEdgeRight).Weight = xlThick Then
    start = i
    End If

Next i

' supprimer la ligne

    If start <> 29 And start <> 0 Then

With wks
    .Range(.Cells(3, start), .Cells(59, start)).Borders(xlEdgeRight).LineStyle = xlNone
End With
ElseIf start = 0 Then GoTo dessiner
Else
With wks
    .Range(.Cells(3, start), .Cells(59, start)).Borders(xlEdgeRight).Weight = xlThin
End With

End If
' dessiner la ligne actuelle

dessiner:

start = Hour(Now())
start = start + 5
With wks
    .Range(.Cells(3, start), .Cells(59, start)).Borders(xlEdgeRight).LineStyle = xlContinuous
    .Range(.Cells(3, start), .Cells(59, start)).Borders(xlEdgeRight).Weight = xlThick
    .Range(.Cells(3, start), .Cells(59, start)).Borders(xlEdgeRight).Color = RGB(255, 0, 0)
End With

End Sub

Merci eriiic pour ton aide et du temps consacré à tous nous aider.

Excellente soirée!

jojo la frite

Bonjour,

tu peux. Mais, quand c'est possible, découper son code en fonctions bien précises est une bonne habitude à prendre.

Une fois chaque partie bien testée et déboguée tu sais que tu n'as plus à revenir dessus.

Et ça facilite la lecture quand tu dois le faire évoluer 6 mois plus tard.

eric

Rechercher des sujets similaires à "ignorer pas afficher message information"