Discussion :

[Vaalor]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
ChDir ThisWorkbook.Path
Workbooks.Open(ThisWorkbook.Path & "\TI-00000-0001.xls*")

Résoudre le problème de l'extension :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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.

[Vaalor]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[unparia]

Bonjour

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

mais

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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