XL 2010 Ouvrir fichier dans repertoire par defaut

[TVulcain]

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)]

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

Bruno

 

[TVulcain]

Merci bruno
je te tiens au courant

 

[TVulcain]

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

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)]

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]

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]

Bonjour le fil,

Le code ci-dessous fonctionne chez moi
(les deux classeurs sont ouverts)

Sub test_OK()
Workbooks("Export.xls").Sheets(1).UsedRange.Copy
Windows("Fichiertravail.xlsm").Activate
Range("A2").PasteSpecial Paste:=xlPasteValues
End Sub

 

[TVulcain]

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.

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]

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

Sub test2_OK()
Workbooks("Export.xls").Sheets(1).UsedRange.Copy Workbooks("Fichiertravail.xlsm").Sheets(1).[A2]
End Sub

 

[TVulcain]

A ben mince alors on m'a dit le contraire

 

[Staple1600]

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

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]

Re

Et ci-dessous un code "allégé" qui produit le même résultat que le code précédent

Sub coderemanié()
[A1].CurrentRegion.Font.Bold = True
[A1].CurrentRegion.Borders.LineStyle = xlContinuous
End Sub

Sans Select et sans Activate.

 

[TVulcain]

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

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]

Re

Je te laisse tester cette syntaxe non issue de l'enregistreur de macros
(sur mon PC de test, c'est OK)

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

 

[TVulcain]

ok merci