Aide sur generation et actualisation [Résolu]

Signaler
Messages postés
27
Date d'inscription
dimanche 13 janvier 2008
Statut
Membre
Dernière intervention
19 juillet 2010
-
Messages postés
27
Date d'inscription
dimanche 13 janvier 2008
Statut
Membre
Dernière intervention
19 juillet 2010
-
bonjour j ai un programme excel , un ensemble de macro et un petit userform permettant la mise en place d un sommaire automatique à partir des dossiers et sous dossiers du repertoire courant , j'aimerais innover en rajoutant la possibilité de saisir le titre du sommaire le problème c est que la generation se fait une ouverture sur deux du fichier excel avec le dernier titre saisie c est surement un probleme d actualisation de donnée voici deja le userform:
Private Sub CommandButton1_Click()

Range("B1").Select
ActiveCell.Value = UserForm1.saisiesommaire.Value
Creation_Hypertexte
End Sub


voici ensuite creation_Hypertexte:
Sub Creation_Hypertexte()

Macro1



Range("A10").Select

MyPath = ActiveWorkbook.Path & ""
MyName = Dir(MyPath, vbDirectory)
i = 0
Do While MyName <> ""
    i = i + 1
    If MyName <> "." And MyName <> ".." And MyName <> ActiveWorkbook.Name Then
        If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
                ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=MyPath & MyName, TextToDisplay:="|=>" & MyName
                ActiveCell.Font.Underline = False
                ActiveCell.Offset(1, 0).Select
                
                MyName2 = Dir(MyPath & "" & MyName & "", vbDirectory)
                Do While MyName2 <> ""
                    If MyName2 <> "." And MyName2 <> ".." Then
                        If (GetAttr(MyPath & MyName & "" & MyName2) And vbDirectory) = vbDirectory Then
                        ActiveCell.Offset(0, 1).Select
                        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=MyPath & MyName & "" & MyName2, TextToDisplay:="|=>" & MyName2
                        ActiveCell.Font.Underline = False
                        ActiveCell.Offset(1, -1).Select
                        End If
                        
                    End If
                MyName2 = Dir
                Loop
                MyName2 = Dir(MyPath & "" & MyName & "", vbDirectory)
                Do While MyName2 <> ""
                    If MyName2 <> "." And MyName2 <> ".." Then
                        If (GetAttr(MyPath & MyName & "" & MyName2) And vbDirectory) <> vbDirectory Then
                        ActiveCell.Offset(0, 1).Select
                        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=MyPath & MyName & "" & MyName2, TextToDisplay:=MyName2
                        ActiveCell.Font.Italic = True
                        ActiveCell.Font.Underline = False
                        ActiveCell.Offset(1, -1).Select
                        End If
                    End If
                MyName2 = Dir
                Loop
               
                
                
        End If
    End If
    
    MyName = Dir(MyPath, vbDirectory)
    For j = 0 To i
        MyName = Dir
    Next
    ActiveCell.Offset(2, 0).Select
Loop


    With ActiveWorkbook.PublishObjects("Sommaire Auto_21817")
        .HtmlType = xlHtmlStatic
        .Filename = _
        ".\Sommaire automatique.htm"
        .Publish (False)
    End With
    ChDir "D:\Data"



End Sub


et macro1 qui ne vous servira pas je pense
Sub Macro1()
'
' Macro1 Macro
' Macro enregistrée le 19/03/2009 par dolyj
'

'
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Font.ColorIndex = 11
    With Selection.Font
        .Name = "Arial"
        .Size = 16
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = True
        .ColorIndex = 11
    End With
    Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
End Sub



voila merci de m'aider si possible a comprendre pourquoi la generation ne se fait qu'une fois sur 2

6 réponses

Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
74
Salut
Une chose me saute aux yeux :
Tu fais une boucle avec un Dir pour la recherche des répertoires disponibles à partir du Path de ton classeur, mais dans la boucle Do-Loop, tu utilises à nouveau un Dir pour renseigner MyName2.
Or, la fonction Dir n'a qu'un seul buffer : Elle est donc réinitialisée lors d'une redéfinition --> Les résultats se mélangent.

Voir <cette classe> utilisable sous Excel

D'autre part, tu demandes un Dir(MyPath, vbDirectory)
Donc, le Dir ne te renverra que des répertoires : Pourquoi retestes-tu l'attribut vbDirectory ?
C'est inutile.

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
74
ou plutôt <la source> remaniée de RenField qui a résolu quelques problèmes soulevés par ma source.
Messages postés
27
Date d'inscription
dimanche 13 janvier 2008
Statut
Membre
Dernière intervention
19 juillet 2010

je suis assez d'accord avec ce que tu m as dit parce qu en fait ce code n est pas encore tout à fait le mien et je fonctionne par etapes et ce que tu as ecrit bien que pertinent ne semble pas etre la source de mon probleme c est a dire la generation automatique du html 1 fois sur deux j ai tort?
Messages postés
27
Date d'inscription
dimanche 13 janvier 2008
Statut
Membre
Dernière intervention
19 juillet 2010

je confirme ce que je viens de dire puisque j ai modifié ça mais je dois toujours cliquer deux fois sur valider avant d avoir le sommaire html
Messages postés
27
Date d'inscription
dimanche 13 janvier 2008
Statut
Membre
Dernière intervention
19 juillet 2010

autre question qui n a rien a voir ; je clique sur valider du userform et j attends que celui ci se ferme finisse son execution puis dans l ideal ferme excel

ici rien ne se ferme et le code s execute je ne sais pas comment ça marche
Messages postés
27
Date d'inscription
dimanche 13 janvier 2008
Statut
Membre
Dernière intervention
19 juillet 2010

bon j ai reussi en modifiant le code à faire ce que je veux si ça interesse y a qu a demander mais je ne l ai pas fini je dois juste changer les liens mal fait mais c est facile