VBA - Ouverture de Page Excel

Version imprimable

Bonjour,

Je suis pour le moment novice dans le VBA,
Mais je cherches à réaliser une manipulation bien précise.

Le but:

Excel A contenant la Macro, Excel B Un classeur avec des informations que je dois récupérer.

Problème :

Aucun chemin d'accès possible . ( Plusieurs PC et Serveurs différents)
Nom du fichier Excel commençant de la même façon Exemple (TI-0000-0001,TI-0000-0002,TI-0000-0003)
Extension différente (xls ; xlsx : xlsm)

Où j'en suis:

Les deux fichiers seront dans le même répertoire pour résoudre au problème du chemin d'accès avec ceci:
Code:

1 2 ChDir ThisWorkbook.Path Workbooks.Open(ThisWorkbook.Path & "\TI-00000-0001.xls*")
Résoudre le problème de l'extension :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 ChDir ThisWorkbook.Path On Error Resume Next Set classeur_rmf = Workbooks.Open(ThisWorkbook.Path & "\TI-00000-0001.xls*") If Not classeur_rmf Is Nothing Then 'Control si le classeur a été ouvert précèdement Set classeur_rmf = Workbooks.Open(ThisWorkbook.Path & "\TI-00000-0001.xlsx") If Not classeur_rmf Is Nothing Then 'Control si le classeur a été ouvert précèdement Set classeur_rmf = Workbooks.Open(ThisWorkbook.Path & "\TI-00000-0001.xlsm") End If End If
Mais je n'arrive pas à trouver le moyen ouvrir mon Fichier avec ce genre de solution:

Code:

Workbooks.Open(ThisWorkbook.Path & "\TI-" & "*.xlsm"

Voilà où j'en suis actuellement, donc j'ai besoin de votre aide pour ouvrir un Excel commençant par TI qui ce trouve dans le même répertoire que ma macro.

Bon j'ai plus ou moins réussi en magouillant.

Si quelqu'un connait autre chose pour faire correctement la macro, c'est avec plaisir. Sinon voila le torchon.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
Sub *****()

valeur = Range("B1").Value

ChDir ThisWorkbook.Path
        On Error Resume Next
        Set classeur_rmf = Workbooks.Open(ThisWorkbook.Path & "\" & valeur & ".xls")
 
        If Not classeur_rmf Is Nothing Then 'Control si le classeur a été ouvert précèdement
 
        Set classeur_rmf = Workbooks.Open(ThisWorkbook.Path & "\" & valeur & ".xlsx")
 
        If Not classeur_rmf Is Nothing Then 'Control si le classeur a été ouvert précèdement
 
        Set classeur_rmf = Workbooks.Open(ThisWorkbook.Path & "\" & valeur & ".xlsm")
 
        End If
        End If
         Columns("A:J").Select
    Selection.Copy
    Application.Left = 499.75
    Application.Top = 41.5
    Windows("******.xlsm").Activate
    Columns("C:C").Select
    ActiveSheet.Paste
    Range("C1:L1").Select
    Application.CutCopyMode = False
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Rows("1:1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$L$24").AutoFilter Field:=3, Criteria1:="=****/*", _
        Operator:=xlAnd
    ActiveSheet.Range("$A$1:$L$24").AutoFilter Field:=12, Criteria1:="<>***", _
        Operator:=xlAnd
    Rows("2:500").Select
    Selection.Delete Shift:=xlUp
    Selection.AutoFilter
    Columns("D:BB").Select
    Selection.Delete Shift:=xlToLeft
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "********"
    Range("C2").Select
    Columns("C:C").ColumnWidth = 17.57
    
    Range("C1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("C1").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    
    
        Windows(valeur & ".xls").Activate
        Windows(valeur & ".xlsx").Activate
        Windows(valeur & ".xlsm").Activate
        ActiveWindow.Close
    
End Sub

20/01/2018, 00h01
unparia
Bonjour

Citation:

Si quelqu'un connait autre chose pour faire correctement la macro

Commence déjà par te débarrasser de ces vilains select pour travailler ensuite sur la sélection....
On se réfère (et on agit directement sur eux) aux objets Excel à traiter
Exemple (ce n'est qu'un exemple ...):
on n'écrit pas :
Code:

1 2 Range("A1").Select Selection.value = "blabla"
mais

Code:

Range("A1").value = "blabla"

Ouvre par ailleurs ton aide VBA interne à la rubrique Range.Copy, méthode et lis-la, ainsi que l'exemple clair qui y est mis --->> applique --->> ton code s'en trouvera considérablement allégé et plus agile...