Macro sensible

Le 14/03/2015 à 11:44

bonjour à tous,

voilà, j'ai un code dans un fichier qui va chercher des données dans d'autres fichiers. Il fonctionne très bien.

Malheureusement, si l'affichage du fichier source est trop petit et qu'on voit un dièse, comme la photo suivante :

diese

j'ai l'impression qui bloque et m'annonce que cette semaine là est introuvable. car ce sont des dates.

j'ai fait l'essai en mettant un affichage correct et ça a marché :

diese2

Le souci, c'est que le fichier source peut être ouvert sur différents ordinateurs et que les personnes modifie l'affichage au regard de la taille de leur écran.

je vous mets le code ci-dessous et surtout j'espère avoir été clair !!

bon WE Francky

Option Explicit

Dim Docdép, Fdép, i, j, Dte, N°Sem, Col, C
Dim FDVA, FDVB, FDVC_D, FDVC_G, Chemin

Sub Import()

    Application.ScreenUpdating = False
    Set Docdép = ActiveWorkbook
    Set Fdép = ActiveSheet

    FDVA = "Effectifs" & Year(Cells(5, "C").Value) & " FDVA.xlsx"
    FDVB = "Effectifs" & Year(Cells(5, "C").Value) & " FDVB.xlsx"
    FDVC_D = "Effectifs" & Year(Cells(5, "C").Value) & " FDVC D.xlsx"
    FDVC_G = "Effectifs" & Year(Cells(5, "C").Value) & " FDVC G.xlsx"
    Chemin = ThisWorkbook.Path & "\"
    On Error GoTo PasDeFichier
    Workbooks.Open Filename:=Chemin & FDVA
    Workbooks.Open Filename:=Chemin & FDVB
    Workbooks.Open Filename:=Chemin & FDVC_D
    Workbooks.Open Filename:=Chemin & FDVC_G

    On Error GoTo 0
    Docdép.Activate
    j = 3

    While IsDate(Cells(5, j).Value) = True
            Dte = Cells(5, j).Value
            N°Sem = DateSerial(Year(Int(Dte) + (8 - Weekday(Int(Dte))) Mod 7 - 3), 1, 1)
            N°Sem = CStr(((Int(Dte) - N°Sem - 3 + (Weekday(N°Sem) + 1) Mod 7)) \ 7 + 1)
            On Error GoTo SemaineManquante

            With Workbooks(FDVA).Sheets(N°Sem) '.Range("I96").Value
                Col = .Range("C89:I89").Find(What:=Day(Dte), LookIn:=xlValues, LookAt:=xlWhole).Column
                For i = 0 To 10
                    Cells(i + 6, j).Value = .Cells(i + 90, Col).Value
                    If UCase(Cells(i + 6, j)) = False Then Cells(i + 6, j).ClearContents
                Next i
            End With

            With Workbooks(FDVB).Sheets(N°Sem) '.Range("I96").Value
                Col = .Range("C89:I89").Find(What:=Day(Dte), LookIn:=xlValues, LookAt:=xlWhole).Column
                For i = 0 To 10
                    Cells(i + 17, j).Value = .Cells(i + 90, Col).Value
                    If UCase(Cells(i + 17, j)) = False Then Cells(i + 17, j).ClearContents
                Next i
            End With

            With Workbooks(FDVC_D).Sheets(N°Sem) '.Range("I96").Value
                Col = .Range("C89:I89").Find(What:=Day(Dte), LookIn:=xlValues, LookAt:=xlWhole).Column
                For i = 0 To 7
                    Cells(i + 28, j).Value = .Cells(i + 90, Col).Value
                    If UCase(Cells(i + 28, j)) = False Then Cells(i + 28, j).ClearContents
                Next i
            End With

            With Workbooks(FDVC_G).Sheets(N°Sem) '.Range("I96").Value
                Col = .Range("C89:I89").Find(What:=Day(Dte), LookIn:=xlValues, LookAt:=xlWhole).Column
                For i = 0 To 7
                    Cells(i + 36, j).Value = .Cells(i + 90, Col).Value
                    If UCase(Cells(i + 36, j)) = False Then Cells(i + 36, j).ClearContents
                Next i
            End With
            j = j + 1
    Wend
    Application.DisplayAlerts = False
    Windows("Effectifs2015 FDVA.xlsx").Activate
    ActiveWindow.Close
    Windows("Effectifs2015 FDVB.xlsx").Activate
    ActiveWindow.Close
    Windows("Effectifs2015 FDVC D.xlsx").Activate
    ActiveWindow.Close
    Windows("Effectifs2015 FDVC G.xlsx").Activate
    ActiveWindow.Close

Exit Sub

PasDeFichier:
    MsgBox "     Le fichier " & Chr(13) & "     " & FDVA & Chr(13) & Chr(13) & _
            "     ou le fichier " & Chr(13) & "     " & FDVB & Chr(13) & Chr(13) & _
            "     ou le fichier " & Chr(13) & "     " & FDVC_D & Chr(13) & Chr(13) & _
            "     ou le fichier " & Chr(13) & "     " & FDVC_G & Chr(13) & Chr(13) & " est introuvable !", 16
    End
SemaineManquante:
    MsgBox "La semaine " & N°Sem & " est introuvable !", 16

End Sub
Le 14/03/2015 à 11:52

Je suis étonné ... l'affichage est une chose, mais c'est bien le contenu qui est important et lui ne change pas.

Lors de l'importation des données, tu peu toujours faire un réajustement automatique de la largeur des colonnes.

Le 14/03/2015 à 12:18

bonjour Steelson,

merci pour ta réponse, moi aussi je suis étonné, je vais tout de même faire des importations dans le WE avec deux type d'affichage et je viendrais vous confirmer que c'est bien là le problème.

Francky

Le 14/03/2015 à 17:55

Bonjour, bonjour !

Steelson a écrit :

Je suis étonné ... l'affichage est une chose, mais c'est bien le contenu qui est important et lui ne change pas.

Lors de l'importation des données, tu peu toujours faire un réajustement automatique de la largeur des colonnes.

Pas étonnant car la méthode Find fonctionne bien avec l'affichage !

Et oui la solution est bien d'utiliser la méthode AutoFit pour ajuster la largeur des colonnes …

Le 14/03/2015 à 18:15

Re-bonjour à tous les deux,

en effet, j'ai refais des test et lorsque je diminue l'affichage et que les cellules ne peuvent plus afficher leur contenu, la macro trouve pas la semaine.

Je ne maitrise pas le VBA et je me suis fais aider pour ce code. Ok pour AutoFit mais je le mets où dans mon code ?

dans l'attente de vous lire,

Francky

Le 17/03/2015 à 15:01

bonjour,

faut-il que je remplace "Find" par "AutoFit" ? comme dans le bout de code ci-dessous :

With Workbooks(FDVA).Sheets(N°Sem) '.Range("I96").Value
                Col = .Range("C89:I89").[barrer]Find[/barrer]AutoFit[/color](What:=Day(Dte), LookIn:=xlValues, lookat:=xlWhole).Column
                For i = 0 To 10
                    Cells(i + 6, j).Value = .Cells(i + 90, Col).Value
                    If UCase(Cells(i + 6, j)) = False Then Cells(i + 6, j).ClearContents
                Next i
            End With

Cordialement,

Francky

Le 17/03/2015 à 16:52

re-bonjour,

en fouillant sur le site j'ai trouvé comment activer le zoom à 100%, j'ai donc modifié ma macro, et ça marche !

par contre ça ralentit considérablement le programme.

Option Explicit

Dim Docdép, Fdép, i, j, Dte, N°Sem, Col, c
Dim FDVA, FDVB, FDVC_D, FDVC_G, Chemin

Sub Import()

    Application.ScreenUpdating = False
    Set Docdép = ActiveWorkbook
    Set Fdép = ActiveSheet

    FDVA = "Effectifs" & Year(Cells(5, "C").Value) & " FDVA.xlsx"
    FDVB = "Effectifs" & Year(Cells(5, "C").Value) & " FDVB.xlsx"
    FDVC_D = "Effectifs" & Year(Cells(5, "C").Value) & " FDVC D.xlsx"
    FDVC_G = "Effectifs" & Year(Cells(5, "C").Value) & " FDVC G.xlsx"
    Chemin = ThisWorkbook.Path & "\"
    On Error GoTo PasDeFichier
    Workbooks.Open Filename:=Chemin & FDVA
    Workbooks.Open Filename:=Chemin & FDVB
    Workbooks.Open Filename:=Chemin & FDVC_D
    Workbooks.Open Filename:=Chemin & FDVC_G

    On Error GoTo 0
    Docdép.Activate
    j = 3

    While IsDate(Cells(5, j).Value) = True
            Dte = Cells(5, j).Value
            N°Sem = DateSerial(Year(Int(Dte) + (8 - Weekday(Int(Dte))) Mod 7 - 3), 1, 1)
            N°Sem = CStr(((Int(Dte) - N°Sem - 3 + (Weekday(N°Sem) + 1) Mod 7)) \ 7 + 1)
            On Error GoTo SemaineManquante

            With Workbooks(FDVA).Sheets(N°Sem) '.Range("I96").Value
                ActiveWindow.Zoom = 100 
                 Col = .Range("C89:I89").Find(What:=Day(Dte), LookIn:=xlValues, lookat:=xlWhole).Column
                For i = 0 To 100
                    Cells(i + 6, j).Value = .Cells(i + 90, Col).Value
                    If UCase(Cells(i + 6, j)) = False Then Cells(i + 6, j).ClearContents
                Next i
            End With

            With Workbooks(FDVB).Sheets(N°Sem) '.Range("I96").Value
              ActiveWindow.Zoom = 100 
                Col = .Range("C89:I89").Find(What:=Day(Dte), LookIn:=xlValues, lookat:=xlWhole).Column
                For i = 0 To 10
                    Cells(i + 17, j).Value = .Cells(i + 90, Col).Value
                    If UCase(Cells(i + 17, j)) = False Then Cells(i + 17, j).ClearContents
                Next i
            End With

            With Workbooks(FDVC_D).Sheets(N°Sem) '.Range("I96").Value
                ActiveWindow.Zoom = 100 
               Col = .Range("C89:I89").Find(What:=Day(Dte), LookIn:=xlValues, lookat:=xlWhole).Column
                For i = 0 To 7
                    Cells(i + 28, j).Value = .Cells(i + 90, Col).Value
                    If UCase(Cells(i + 28, j)) = False Then Cells(i + 28, j).ClearContents
                Next i
            End With

            With Workbooks(FDVC_G).Sheets(N°Sem) '.Range("I96").Value
                ActiveWindow.Zoom = 100 
                Col = .Range("C89:I89").Find(What:=Day(Dte), LookIn:=xlValues, lookat:=xlWhole).Column
                For i = 0 To 7
                    Cells(i + 36, j).Value = .Cells(i + 90, Col).Value
                    If UCase(Cells(i + 36, j)) = False Then Cells(i + 36, j).ClearContents
                Next i
            End With
            j = j + 1
    Wend
    Application.DisplayAlerts = False
    Windows("Effectifs2015 FDVA.xlsx").Activate
    ActiveWindow.Close
    Windows("Effectifs2015 FDVB.xlsx").Activate
    ActiveWindow.Close
    Windows("Effectifs2015 FDVC D.xlsx").Activate
    ActiveWindow.Close
    Windows("Effectifs2015 FDVC G.xlsx").Activate
    ActiveWindow.Close

Exit Sub

PasDeFichier:
    MsgBox "     Le fichier " & Chr(13) & "     " & FDVA & Chr(13) & Chr(13) & _
            "     ou le fichier " & Chr(13) & "     " & FDVB & Chr(13) & Chr(13) & _
            "     ou le fichier " & Chr(13) & "     " & FDVC_D & Chr(13) & Chr(13) & _
            "     ou le fichier " & Chr(13) & "     " & FDVC_G & Chr(13) & Chr(13) & " est introuvable !", 16
    End
SemaineManquante:
    MsgBox "La semaine " & N°Sem & " est introuvable !", 16

End Sub

j'ai surligné les lignes que j'ai rajouté

dans l'attente de vous lire,

Francky

Le 20/03/2015 à 10:32

bon, n'ayant pas de réponse de VBAïste, je vais validé ce post.

j'espère que la démo de cette après-midi ne plantera pas.

Bon WE

Francky

Rechercher des sujets similaires à "macro sensible"