Je souhaite une macro qui ouvre un fichier excel. Résolu Merci

Je souhaite une macro qui ouvre un fichier excel. Résolu Merci - VB/VBA/VBS - Programmation

Marsh Posté le 06-09-2013 à 13:23:20    

Bonjour,
 
Je souhaite une macro qui ouvre un fichier excel.
Tous les cellules ont un nom différent, mais la même colonne la H2 jusqu' a l'infini.
Vers le même chemin x:\feuille de lancement\a4
 
les fichiers sont du type 15084.xlsm
15085.xlsm ect....
 
je voudrais que quand on clic dessus qu'il s'ouvre.
 
Merci a vous


Message édité par tispirit le 10-09-2013 à 13:05:57
Reply

Marsh Posté le 06-09-2013 à 13:23:20   

Reply

Marsh Posté le 06-09-2013 à 15:58:06    

 
          http://feeclochette26.f.e.pic.centerblog.net/3u1vjbc1.gif   Et la marmotte met le chocolat dans le papier alu ‼
 
 
           Bonjour,
 
           voir les règles du forum …
 
           En clair, c'est un forum de programmeurs, pas de j'y viens passer ma commande !
 
           Pour débuter, l'Enregistreur de macros ainsi que l'aide intégrée d'Excel et du VBA sont vos amis …
  

Reply

Marsh Posté le 06-09-2013 à 18:01:06    

bonjour
 
Lol j'aime beaucoup.  
 
Donc on va repartir sur des bonne bases.
 
J'appelle sa une feuille de lancement.
Certaine cellule sont reporté sur une ligne dit historique.
 
En programmant moi même sans passer commande
 
La c2, c4, c8, c12, c24 et e24sur une ligne dans la liste enregistré et sauvé suivant les nom des cellule variantes (bien sur) sans passer commande.
 
Mais dans le fichier liste avec les hyperliens (en cliquant dessus) il est impossible que le fichier s'ouvre dans la destination demandé.  
 
 
Question comment je peu faire pour que les lien arrive au fichier? x:\feuille de lancement\a4  
 
 
le fichier
https://mega.co.nz/#!x8w2CIAR!PLNT7 [...] kK4xzabdC4
 
 
Voici la macro
 
Sub Engistré()
 
 
 
Windows("LANCEMENT 2009 (version 1) alpha test.xlsm" ).Activate
Sheets("Liste" ).Select
 
 Rows("1:1" ).Select
    Range("B1" ).Activate
    Selection.Copy
    Rows("2:2" ).Select
    Range("B2" ).Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = True
 
ThisWorkbook.Activate
 
Range("B65536" ).End(xlUp).Rows.Activate
If ActiveCell.Value = "" Then
  Range("B2:H2" ).Copy Destination:=ActiveCell.Value
Else
  Range("B2:H2" ).Copy Destination:=ActiveCell.Offset(1, 0)
End If
   
 
Windows("LANCEMENT 2009 (version 1) alpha test.xlsm" ).Activate
   
  Sheets("REN DOS" ).Select
   
  ActiveWorkbook.Save
 
 
 
Windows("LANCEMENT 2009 (version 1) alpha test.xlsm" ).Activate
     
  Sheets("REN DOS" ).Select
    ActiveWorkbook.Save
   
 
 Windows("LANCEMENT 2009 (version 1) alpha test.xlsm" ).Activate
   
  Sheets("REN DOS" ).Select
   
  ActiveWorkbook.Save
   
 
  Sheets("REN DOS" ).Select
    ActiveWorkbook.SaveCopyAs Filename:=[C4].Value & ".xls"
  ActiveWorkbook.Save
  Sheets("REN DOS" ).Select
    ChDir "X:\Feuille de lancement\A4\"
    ActiveWorkbook.SaveCopyAs Filename:=[E24].Value & ".xls"
    Application.DisplayAlerts = True
    MsgBox ("Votre fichier a bien été enregistré" ) 'Fenêtre d'information
     
     
   
    Exit Sub
End Sub
 
 
 
 

Reply

Marsh Posté le 06-09-2013 à 20:05:34    

 
           Merci d'utiliser la prochaine fois l'icône C dédiée pour encadrer le code …
 
           Je pensais avoir compris lors du premier message mais le contenu du second me laisse dubitatif …
 
           Voici un exemple facilement adaptable à copier dans le module de classe de la feuille contenant les noms de fichiers.
           Par un double-clic, si le fichier existe alors il est ouvert …
 

Code :
  1. Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  2.     If Target.Count = 1 Then
  3.         If Dir$(Target.Value) > "" Then
  4.             Cancel = True
  5.             Workbooks.Open Target.Value, 0
  6.         End If
  7.     End If
  8. End Sub

 

Reply

Marsh Posté le 10-09-2013 à 12:36:05    

Bonjour  
 
dsl du retard.
 
J'ai pu l'intégré a ma macro.
 
erreur Sub
 

Code :
  1. Sub Engistré()
  4. Sheets("Liste" ).Select
  6. Rows("1:1" ).Select
  7.     Range("B1" ).Activate
  8.     Selection.Copy
  9.     Rows("2:2" ).Select
  10.     Range("B2" ).Activate
  11.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  12.         :=False, Transpose:=False
  13.     Application.CutCopyMode = False
  15. ThisWorkbook.Activate
  17. Range("B65536" ).End(xlUp).Rows.Activate
  19. If ActiveCell.Value = "" Then
  21.   Range("B2:H2" ).Copy Destination:=ActiveCell.Value
  23. Else
  25.   Range("B2:H2" ).Copy Destination:=ActiveCell.Offset(1, 0)
  26.  
  27.     Rows("2:2" ).Select
  28.     Range("B2" ).Activate
  29.     Selection.Copy
  30.     Workbooks.Open Filename:="X:\Feuille de lancement\liste.xlsm"
  31.     Rows("1:1" ).Select
  32.     Range("A2" ).Activate
  33.     ActiveSheet.Paste
  34.     Application.CutCopyMode = False
  35.     Range("B65536" ).End(xlUp).Rows.Activate
  37. If ActiveCell.Value = "" Then
  39.   Range("B2:H2" ).Copy Destination:=ActiveCell.Value
  41. Else
  43.   Range("B2:H2" ).Copy Destination:=ActiveCell.Offset(1, 0)
  44.     ActiveWorkbook.Save
  45.     ActiveWindow.Close
  46.     ActiveWorkbook.Save
  47.    
  48.     End If
  49.  
  50.   Sheets("REN DOS" ).Select
  51.  
  52.   ActiveWorkbook.Save
  53.  
  54.   Sheets("REN DOS" ).Select
  55.  
  57.     ChDir "X:\Feuille de lancement"
  58.     ActiveWorkbook.SaveCopyAs Filename:=[C4].Value & ".xls"
  59.        
  60.   ActiveWorkbook.Save
  61.  
  62.   Sheets("REN DOS" ).Select
  65.     ChDir "X:\Feuille de lancement\A4\"
  66.     ActiveWorkbook.SaveCopyAs Filename:=[F24].Value & ".xls"
  69. Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  70.     If Target.Count = 1 Then
  71.         If Dir$(Target.Value) > "" Then
  72.             Cancel = True
  73.             Workbooks.Open Target.Value, 0
  74.         End If
  75.     End If
  78. End If
  79.     Application.DisplayAlerts = True
  80.     MsgBox ("Votre fichier a bien été enregistré" ) 'Fenêtre d'information
  81.        
  84.     Exit Sub
  85. End Sub


 
en retirant "Private Sub" la ligne devient rouge. bizarre


Message édité par tispirit le 10-09-2013 à 12:37:20
Reply

Marsh Posté le 10-09-2013 à 12:54:23    

 
           Ouh la la la la ‼‼   On ne peut pas placer une procédure dans une autre ‼
 

Code :
  1. Sub Engistré()
  2.     { code }
  3. End Sub
  5. Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  6.     If Dir$(Target.Value) > "" Then Cancel = True: Workbooks.Open Target.Value, 0
  7. End Sub


           Et, comme déjà indiqué, le code de l'évènement BeforeDoubleClick ne doit pas être dans un module normal
           mais dans le module de classe de la feuille (par exemple Feuil1) …
 

Reply

Marsh Posté le 10-09-2013 à 13:05:05    

Ha ok merci beaucoup!

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed