XL 2010 Ouvrir fichier dans repertoire par defaut

TVulcain

XLDnaute Nouveau
Bonjour

J'aimerais ouvrir un fichier xls à partir de ma macro lancé par mon application

avec Workbooks.Open Filename:="Export.xls" manifestement il ne connait pas le chemin pour l'ouvrir.
Je voudrais l'ouvrir à partir du même répertoire que mon application et pourtant ne spécifiant pas de chemin je pensais que cela allait se faire par defaut.
merci
 

youky(BJ)

XLDnaute Barbatruc
Hello TVulcain,
cheminfichier=Thisworkbook.path & "\Export.xls"
Workbooks.Open Filename:=cheminfichier
ou sans variable
Workbooks.Open Filename:=Thisworkbook.path & "\Export.xls"

Bruno
 

TVulcain

XLDnaute Nouveau
Bonjour Bruno

Apparemment le fichier s'ouvre mais avec les instructions suivant le paste ne s'exécute pas car le fichier ouvert est vide

VB:
Cells.Select
    Selection.Delete Shift:=xlUp
    Range("A1").Select
    Windows("Export.xls").Activate
    Cells.Select
    Selection.Copy
    Windows("Fichiertravail.xlsm").Activate
    Cells.Select
    ActiveSheet.Paste
    Range("A2").Select
 

youky(BJ)

XLDnaute Barbatruc
Hello,
Une fois le fichier ouvert c'est lui qui est Activé
Donc Selection.Delete vide la page du fichier ouvert
Après avoir ouvert le fichier
on indique l'ongletà copier et on copy sur Thisworkbook.sheets("????").[A1].pastespecial
Bruno
 

TVulcain

XLDnaute Nouveau
Bon avant bruno j'utilisais l'enregistreur de macro et le première ligne supprime le contenu de fichier, donc mon message d'avant il est normal que le fichier soit vide.
Le paste ne passe pas donc je pense qu'il est préférable de passer par une boucle et réaliser l'impor direct en VBA
 

Staple1600

XLDnaute Barbatruc
Bonjour le fil,

Le code ci-dessous fonctionne chez moi
(les deux classeurs sont ouverts)
VB:
Sub test_OK()
Workbooks("Export.xls").Sheets(1).UsedRange.Copy
Windows("Fichiertravail.xlsm").Activate
Range("A2").PasteSpecial Paste:=xlPasteValues
End Sub
 

TVulcain

XLDnaute Nouveau
Ok bruno, toutes tes instructions fonctionnent mais le paste est d'une lenteur donc il faut une procédure avec une boucle
Staple avec la modif c'est ok, merci à vous deux
Maintenant pour que l'import soit plus rapide, je réalise la macro et la poste car il pourrait avoir souci.
Si ok, je poste avec commentaire

La modif pour ceux que cela intéresse.

VB:
Sub importation()
'
' importation Macro
'
'
' Thierry
Dim cheminfichier As String

cheminfichier = ThisWorkbook.Path & "\Export.xls"
Workbooks.Open Filename:=cheminfichier

    Cells.Select
    Selection.Copy
    Windows("Fichiertravail.xlsm").Activate
    Cells.Select
    ThisWorkbook.Sheets("feuil1").[A1].PasteSpecial
    Range("A2").Select
   
End Sub
 

Staple1600

XLDnaute Barbatruc
Re,

En général, on conseille d'éviter les Select.
Cela ralentit l’exécution du code.
C'est pour cela qu'il n'y en avait pas dans ma proposition...rolleyes:

D'ailleurs, cela devrait aussi fonctionner sans activate ;)
VB:
Sub test2_OK()
Workbooks("Export.xls").Sheets(1).UsedRange.Copy Workbooks("Fichiertravail.xlsm").Sheets(1).[A2]
End Sub
 

Staple1600

XLDnaute Barbatruc
Re

Surement pas sur ce forum alors ;)
Les Select et Activate sont souvent des "scories" d'un code VBA obtenu par l'enregistreur de macros.
Exemple ci-dessous un code issu de l’enregistreur de macros
VB:
Sub Macro3()
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    With Selection.Font
        .Name = "Calibri"
        .FontStyle = "Gras"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlThin
    End With
End Sub
 

Staple1600

XLDnaute Barbatruc
Re

Et ci-dessous un code "allégé" qui produit le même résultat que le code précédent
VB:
Sub coderemanié()
[A1].CurrentRegion.Font.Bold = True
[A1].CurrentRegion.Borders.LineStyle = xlContinuous
End Sub
Sans Select et sans Activate.
 

TVulcain

XLDnaute Nouveau
ok c'est fou ça
Je comprends mieux merci
Pour répondre oui sur un autre forum ou je ne vais plus

D'ailleurs en dehors de code VBA que je crée, j'ai un bout en enregistreur, qui est un filtre et qui fonctionne quand il a le temps

ça par exemple ne fonction pas : Range("A2", Selection.End(xlDown)).Cells.Count alors que Range("A1536").End(xlUp).Row
encore un truc



VB:
Dim fin As Integer
'fin = Range("A2", Selection.End(xlDown)).Cells.Count
 fin = Range("A1536").End(xlUp).Row ' fin de fichier
'
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("H2" & ":" & "H" & fin) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("G2" & ":" & "G" & fin) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("E2" & ":" & "E" & fin) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    
    
        
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range("A1" & ":" & "I" & fin)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Range("A2").Select
    Selection.AutoFilter
 

Staple1600

XLDnaute Barbatruc
Re

Je te laisse tester cette syntaxe non issue de l'enregistreur de macros
(sur mon PC de test, c'est OK)
VB:
Sub TEST()
Dim fin As Long, rng As Range
fin = Cells(Rows.Count, 1).End(3).Row
Set rng = Range(Cells(1, "A"), Cells(fin, "H"))
rng.Sort key1:=Range("H2"), Order1:=xlAscending, key2:=Range("G2"), Order2:=xlAscending, key3:=Range("E2"), Order3:=xlAscending, Header:=xlYes
End Sub
 

Staple1600

XLDnaute Barbatruc
Re

On peut encore réduire un chouia le code
(test OK sur mon PC)
VB:
Sub TEST3()
Dim fin As Long
fin = Cells(Rows.Count, 1).End(3).Row
Cells(1).Resize(fin, 8).Sort key1:=[H2], Order1:=1, key2:=[G2], Order2:=1, key3:=[E2], Order3:=1, Header:=1
End Sub
 

TVulcain

XLDnaute Nouveau
J'ai essayé le tri, ça fonctionne impec

Selection.AutoFilter lui, je suis obligé de l'exécuter 2 fois pour avoir accès au filtre
 

Staple1600

XLDnaute Barbatruc
Re,

Normalement avec le filtre aussi pas besoin de Select
VB:
Sub TEST_4()
Dim fin As Long
fin = Cells(Rows.Count, 1).End(3).Row
If Not ActiveSheet.AutoFilterMode Then
'ici mettre ton propre critère de filtre
Cells(1).Resize(fin, 8).AutoFilter Field:=3, Criteria1:="9"
End If
End Sub
 

TVulcain

XLDnaute Nouveau
Ok merci mais pour les critères, sans VBA il ne donne pas de critères donc les numéros correspondandent à quoi
La colonne ?
 

Staple1600

XLDnaute Barbatruc
Re

Comme tu n'as pas joint de fichier exemple, je teste sur mon filtre sur un fichier de mon cru.
Pour voir comment j'ai testé, lance la macro TEST_5 sur une feuille vide
VB:
Sub TEST_5()
Dim fin As Long
créer_données_TEST
fin = Cells(Rows.Count, 1).End(3).Row
If Not ActiveSheet.AutoFilterMode Then
MsgBox "Appliquer le filtre?" & Chr(13) & "Colonne filtrée: C, critère du filtre: =0", vbQuestion, "TEST"
Cells(1).Resize(fin, 8).AutoFilter Field:=3, Criteria1:="0"
End If
End Sub
Sub créer_données_TEST()
[A1] = "ITEM1": [A1].AutoFill Destination:=[A1:H1], Type:=0: [A2:H26] = "=MOD(ROW()-1,5)"
End Sub
 
Dernière édition:

Haut Bas