Sujet Précédent Sujet Suivant

Enregistrer et utiliser chemin d'acces

kromei Messages postés 27 Date d'inscription dimanche 13 janvier 2008 Statut Membre Dernière intervention 19 juillet 2010 - 23 avril 2010 à 14:17
kromei Messages postés 27 Date d'inscription dimanche 13 janvier 2008 Statut Membre Dernière intervention 19 juillet 2010 - 26 avril 2010 à 11:03
bonjour je n 'en peux plus je ne sais absolument pas comment faire

on m a demandé de creer un fichier qui genere une page html a partir des dossiers et sous dossiers du repertoire courant et d enregistrer le tout au meme endroit que la macro

(si on bouge la page le chemin ne marche donc logiquement plus puisque relatif)

les chemins j y arrives encore mais l enregistrement non! il s enregistre dans le "dossier par defaut et c est tres tres enervant j ai essayé de changer ça dans les option mais si on ne met pas de chemin par defaut il bug je veux donc contourner ça en code vba quelqu'un peut m aider? 
Sub Creation_Hypertexte2()

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:="." & MyName, TextToDisplay:="|=>" & MyName
                ActiveCell.Font.Underline = False
                ActiveCell.Offset(1, 0).Select
                
                MyName2 = Dir("." & "" & MyName & "", vbDirectory)
                 Do While MyName2 <> ""
                   ' If MyName2 <> "." And MyName2 <> ".." Then
                       ' If (GetAttr("." & MyName & "" & MyName2) And vbDirectory) = vbDirectory Then
                        ActiveCell.Offset(0, 1).Select
                        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="." & MyName2, TextToDisplay:="|=>" & MyName2
                        ActiveCell.Font.Underline = False
                        ActiveCell.Offset(1, -1).Select
                        'End If
               
                   ' End If
                'MyName2 = Dir
                Loop
                Do While MyName2 <> ""
                    'If MyName2 <> "." And MyName2 <> ".." Then
                       ' If (GetAttr("." & MyName & "" & MyName2) And vbDirectory) <> vbDirectory Then
                        ActiveCell.Offset(0, 1).Select
                        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="." & 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
        ChDrive ActiveWorkbook.Path
        .Filename = _
        "." & "\Sommaire automatique.htm"
        .Publish (False)
    End With
    

End Sub

6 réponses

Réponse 1 / 6
cs_Jack Messages postés 14006 Date d'inscription samedi 29 décembre 2001 Statut Modérateur Dernière intervention 28 août 2015 79
23 avril 2010 à 14:32
Rebonjour

Si tu ne tiens pas compte des réponses qu'on te fait, ça te sert à quoi de les poser ?
http://www.vbfrance.com/forum/sujet-AIDE-SUR-GENERATION-ACTUALISATION_1429106.aspx
0
Réponse 2 / 6
cs_Jack Messages postés 14006 Date d'inscription samedi 29 décembre 2001 Statut Modérateur Dernière intervention 28 août 2015 79
23 avril 2010 à 14:38
En plus, tu as ajouté des bugs :
Dir("." & "" & MyName & "", vbDirectory)
La chaine à l'intérieur des parenthèses va donner :
".\\mon nom"
Est-ce une syntaxe réelle ?
Si oui, tu m'expliqueras

Pour le problème principal te pour faire court :
Tu ne ne dois pas faire de DIR dans une boucle se basant elle même sur un DIR.
Je t'ai donné la solution.
0
Réponse 3 / 6
kromei Messages postés 27 Date d'inscription dimanche 13 janvier 2008 Statut Membre Dernière intervention 19 juillet 2010
23 avril 2010 à 15:51
j essai de prendre tout ça en compte merci ( j ai un peu du mal en vba)
0
Réponse 4 / 6
kromei Messages postés 27 Date d'inscription dimanche 13 janvier 2008 Statut Membre Dernière intervention 19 juillet 2010
26 avril 2010 à 10:03
bonjour j ai essayé d appliquer le code mais deja en le regardant une chose me gene c est qu il faut un chemin absolu et aussi je ne peux pas generer ce code tel quel ; en tout cas il me declanche une erreur "Dim oItems As CDir" ici

ça a l air d etre une histoire de compatibilité de code entre excel et vb j ai excel 2000 c est peut etre ça non?
0

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
26 avril 2010 à 10:42
j'ai simplifié le code à une boucle pour mieux me faire comprendre

j ai une appli excel qui genere un sommaire automatiquement en html
le chemin d acces ne doit pas dependre de path mais doit etre relatif au dossiers c est a dire que si je bouge ma page de place , les liens ne s executent pas
le sommaire s enregistre dans le repertoire de la macro
il y a des sous dossiers mais je les geres plus tard je me concentre sur la premiere bloucle parce que je ne comprends pas vos explications ;
ceci est du vbe sous excel2000 

Sub Creation_Hypertexte()

Application.DefaultFilePath = ActiveWorkbook.Path

Macro1
Range("A10").Select

MyPath = ActiveWorkbook.Path & ""

MyName = Dir(".", 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:=MyName, TextToDisplay:="|=>" & MyName & "1"
                ActiveCell.Font.Underline = False
                ActiveCell.Offset(1, 0).Select
 End If
    End If
    
    MyName = Dir(".", 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
   


End Sub

la macro1 
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

la macro2 
Sub Macro2()
'
' Macro2 Macro
' Macro enregistrée le 23/04/2010 par bastien
'

'
    Cells.Select
    Selection.ClearContents
End Sub


l ouverture d excel 
Private Sub Workbook_Open()
Application.ScreenUpdating = False
UserForm1.Show
ActiveWorkbook.Saved = True
ActiveWorkbook.Close

End Sub
0
Réponse 6 / 6
kromei Messages postés 27 Date d'inscription dimanche 13 janvier 2008 Statut Membre Dernière intervention 19 juillet 2010
26 avril 2010 à 11:03
oups le MyPath je le remplace par "." dans le code a coté du GetAttr mais c est pareil
0

Discussions similaires

ACCESS ET SAP
lolo_bob2 -
lolo_bob2 -

4 réponses
Erreur : Violation d'accès à l'adresse 00482976
cs_titi29 -
Claude -

10 réponses
Erreur d'accès au chemin du dossier
olivier93612 -
NHenry -

10 réponses
violation d’accès à l’adress
malone12 -
Keneda -

5 réponses
acces chemin refusé
dreck500 -
PCPT -

13 réponses
Rejoignez-nous