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
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.
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)
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?
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
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
