1. Accueil
  2. Forum Codes-Sources
  3. Visual Basic
  4. Visual Basic 6
Sujet Précédent Sujet Suivant

Aide sur generation et actualisation

Résolu
kromei Messages postés 27 Date d'inscription dimanche 13 janvier 2008 Statut Membre Dernière intervention 19 juillet 2010 - 22 avril 2010 à 09:11
kromei Messages postés 27 Date d'inscription dimanche 13 janvier 2008 Statut Membre Dernière intervention 19 juillet 2010 - 22 avril 2010 à 13:22
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

Réponse 1 / 6
cs_Jack Messages postés 14007 Date d'inscription samedi 29 décembre 2001 Statut Modérateur Dernière intervention 28 août 2015 79
22 avril 2010 à 09:45
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)
3
Réponse 2 / 6
cs_Jack Messages postés 14007 Date d'inscription samedi 29 décembre 2001 Statut Modérateur Dernière intervention 28 août 2015 79
22 avril 2010 à 09:53
ou plutôt <la source> remaniée de RenField qui a résolu quelques problèmes soulevés par ma source.
3
Réponse 3 / 6
kromei Messages postés 27 Date d'inscription dimanche 13 janvier 2008 Statut Membre Dernière intervention 19 juillet 2010
22 avril 2010 à 10:08
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?
3
Réponse 4 / 6
kromei Messages postés 27 Date d'inscription dimanche 13 janvier 2008 Statut Membre Dernière intervention 19 juillet 2010
22 avril 2010 à 10:18
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
3

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 6
kromei Messages postés 27 Date d'inscription dimanche 13 janvier 2008 Statut Membre Dernière intervention 19 juillet 2010
22 avril 2010 à 10:51
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
3
Réponse 6 / 6
kromei Messages postés 27 Date d'inscription dimanche 13 janvier 2008 Statut Membre Dernière intervention 19 juillet 2010
22 avril 2010 à 13:22
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
3
Rejoignez-nous