kromei
Messages postés27Date d'inscriptiondimanche 13 janvier 2008StatutMembreDernière intervention19 juillet 2010
-
22 avril 2010 à 09:11
kromei
Messages postés27Date d'inscriptiondimanche 13 janvier 2008StatutMembreDernière intervention19 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
cs_Jack
Messages postés14007Date d'inscriptionsamedi 29 décembre 2001StatutModérateurDernière intervention28 août 201579 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.
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)
kromei
Messages postés27Date d'inscriptiondimanche 13 janvier 2008StatutMembreDernière intervention19 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?
kromei
Messages postés27Date d'inscriptiondimanche 13 janvier 2008StatutMembreDernière intervention19 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
kromei
Messages postés27Date d'inscriptiondimanche 13 janvier 2008StatutMembreDernière intervention19 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