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

 

[Staple1600]

Re

Comme j'avais un peu de temps (en attendant que le carrelage sèche )
Voici ta macro Macro7 à ma sauce sans Select

Sub Macro7_sans_Select()
Dim i%, col
col = Array(Array(4, 34.14), Array(5, 40.14), Array(7, 28.129), Array(8, 50))
Application.ScreenUpdating = False
Range("C:D,I:I").Delete Shift:=xlToLeft
For i = 0 To 3: Columns(col(i)(0)).ColumnWidth = col(i)(1): Next
[A1].CurrentRegion.Resize(1).Font.Bold = True
End Sub

Euh... sinon, sur mon PC et mon classeur de test
Ces 4 macros font la même chose

Sub test_A()
Columns("E:E").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
End Sub
Sub test_B()
Columns("E:E").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
End Sub
Sub test_C()
Columns(5).Insert
End Sub
Sub test_D()
[E1].EntireColumn.Insert
End Sub

 

[Staple1600]

Re

Pourquoi avoir effacé ton message!!!
(Celui-ci où il y avait ton dernier code VBA)
Du coup, personne ne peut te proposer d'autres syntaxes possible

(Plus de fichier exemple, plus de code VBA à modifier, c'est malin... et cela rend ton fil de discussion vachement compréhensible... )

 

[TVulcain]

Ok merci, celle ci ne garde pas le format des cellule comme les dates : Columns("E:E").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Encore un petit mystère mais pas grave, j'ai compris la syntaxe

 

[Staple1600]

Re

Moi, j'ai pas compris pourquoi tu as supprimé ton message avec tes derniers codes VBA et le dernier fichier exemple...

 

[TVulcain]

je vais remettre l'exemple pas de panique, mais ainsi le code sera plus propre

Sub Macro2()
'
' Macro2 Macro
'
' Réalisé par Thierry
Set VariableObjet = Nothing
' vide press papier'
Application.CutCopyMode = False
Application.ScreenUpdating = False

' variables pour séparation num de la rue
Dim FL1 As Worksheet, Cell As Range, Plage As Range
Dim Var0, Var1, Var2, Var3, Var4, Var5, Adresse, Cible, EtatBac As String
Dim i, fin As Integer
'
UserForm1.Show 0
DoEvents



' Touche de raccourci du clavier: Ctrl+k
' Importation : le classeur export.xls doit être ouvert
Call importation
    
    
    ' Numéro de ligne import
    i = 2
    
    fin = Range("A2", Selection.End(xlDown)).Cells.Count   ' fin de fichier d'exportation
    
    Set FL1 = Worksheets("Feuil1")
    
    With FL1
        'Détermination de la plage de cellules à lire
        Set Plage = .Range("E2" & ":" & "E" & fin)
        ' Insert colonne Numéro Rue pour modification de chaine caractères Adresse
        Columns("E:E").Select
        Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        Selection.ColumnWidth = 6.3
        
        Columns("F:F").Select
        Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        Selection.ColumnWidth = 4
        
        For Each Cell In Plage
 
            'Valeur de la cellule lue
            Adresse = Cell.Value
            
            Var0 = Cell.Value
            Var0 = Mid(Var0, 1, 1)
            
            Var1 = Cell.Value
            Var1 = Mid(Var1, 1, 2)
            
            Var2 = Cell.Value
            Var2 = Mid(Var2, 1, 3)
            
            Var3 = Cell.Value
            Var3 = Mid(Var3, 1, 4)
            
            Var4 = Cell.Value
            Var4 = Mid(Var4, 1, 5)
            
            Var5 = Cell.Value
            Var5 = Mid(Var5, 1, 6)
            
            EtatBac = Cell.Value
            EtatBac = Worksheets("Feuil1").Range("I" & i)
            
            
            
            
            
            ' **********************************************
            ' Traitement sur zone ou place de numéros de rue
            ' **********************************************
                
            If Val(Mid(Adresse, 1, 1)) > 0 And Val(Mid(Adresse, 3, 1)) > 0 And Val(Mid(Adresse, 5, 1)) > 0 _
            And Mid(Adresse, 2, 1) = " " And Mid(Adresse, 4, 1) = " " And Mid(Adresse, 6, 1) = " " Then
                Cells(i, "E").NumberFormat = "####" ' conserver Format Texte
                Worksheets("Feuil1").Range("E" & i) = Mid(Adresse, 1, 1) & " -" & Mid(Adresse, 3, 1) & " -" & Mid(Adresse, 5, 1)
                Adresse = Right(Adresse, Len(Adresse) - 6)
                Adresse = LTrim(Adresse)
                Worksheets("Feuil1").Range("G" & i) = Adresse
                    
            End If
            
            ' ****************************************************
            ' Traitement valeur normale numéro rue à 1 chriffre
            ' ****************************************************
            If (Val(Var0) > 0 And Val(Var0) <= 9) And Mid(Adresse, 2, 1) = " " Then
                Cells(i, "E").NumberFormat = "####" ' conserver Format num
                Worksheets("Feuil1").Range("E" & i) = Var1
                Adresse = Replace(Adresse, Var1, "")
                Adresse = LTrim(Adresse)
                Worksheets("Feuil1").Range("G" & i) = Adresse
                ' Traitement si B pour Bis sur numéro à 1 chiffre
                If Mid(Adresse, 1, 2) = "B " Or Mid(Adresse, 1, 2) = "C " Or Mid(Adresse, 1, 2) = "D " _
                Or Mid(Adresse, 1, 2) = "E " Or Mid(Adresse, 1, 2) = "F " Or Mid(Adresse, 1, 2) = "G " _
                Or Mid(Adresse, 1, 2) = "H " Or Mid(Adresse, 1, 2) = "I " Or Mid(Adresse, 1, 2) = "Q " _
                Or Mid(Adresse, 1, 2) = "T " Or Mid(Adresse, 1, 2) = "A " Or Mid(Adresse, 1, 2) = "J " _
                Or Mid(Adresse, 1, 2) = "2 " Or Mid(Adresse, 1, 2) = "3 " Or Mid(Adresse, 1, 2) = "4 " _
                Or Mid(Adresse, 1, 2) = "5 " Or Mid(Adresse, 1, 2) = "6 " Or Mid(Adresse, 1, 2) = "7 " _
                Or Mid(Adresse, 1, 2) = "8 " Or Mid(Adresse, 1, 2) = "9 " Or Mid(Adresse, 1, 2) = "B-" Then
                    Cells(i, "E").NumberFormat = "####" ' conserver Format num
                    Worksheets("Feuil1").Range("E" & i) = Var1
                    Worksheets("Feuil1").Range("F" & i) = Mid(Adresse, 1, 1)
                    Adresse = Right(Adresse, Len(Adresse) - 1)
                    Adresse = LTrim(Adresse)
                    Worksheets("Feuil1").Range("G" & i) = Adresse
                End If
                ' Traitement si Bis ou Ter sur numro à 1 chiffre
                If Mid(Adresse, 1, 3) = "BIS" Or Mid(Adresse, 1, 3) = "TER" Or Mid(Adresse, 1, 3) = "B/T" _
                Or Mid(Adresse, 1, 3) = "Bis" Or Mid(Adresse, 1, 3) = "Ter" Then
                    Cells(i, "E").NumberFormat = "####" ' conserver Format num
                    Worksheets("Feuil1").Range("E" & i) = Var1
                    Worksheets("Feuil1").Range("F" & i) = Mid(Adresse, 1, 3)
                    Adresse = Right(Adresse, Len(Adresse) - 3)
                    Adresse = LTrim(Adresse)
                    Worksheets("Feuil1").Range("G" & i) = Adresse
                End If
            Else
                ' ***********************************************
                ' Traitement valeur normale numéro à 2 chiffres
                ' ***********************************************
                
                If Val(Var1) >= 10 And Mid(Adresse, 3, 1) = " " Then
                    Cells(i, "E").NumberFormat = "####" ' conserver Format num
                    Worksheets("Feuil1").Range("E" & i) = Var1
                    Adresse = Replace(Adresse, Var1, "")
                    Adresse = LTrim(Adresse)
                    Worksheets("Feuil1").Range("G" & i) = Adresse
                    
                    ' Traitement si B pour Bis sur numéro à 2 chiffres
                    If Mid(Adresse, 1, 2) = "B " Or Mid(Adresse, 1, 2) = "C " Or Mid(Adresse, 1, 2) = "D " _
                    Or Mid(Adresse, 1, 2) = "E " Or Mid(Adresse, 1, 2) = "F " Or Mid(Adresse, 1, 2) = "G " _
                    Or Mid(Adresse, 1, 2) = "H " Or Mid(Adresse, 1, 2) = "I " Or Mid(Adresse, 1, 2) = "Q " _
                    Or Mid(Adresse, 1, 2) = "T " Or Mid(Adresse, 1, 2) = "A " Or Mid(Adresse, 1, 2) = "J " _
                    Or Mid(Adresse, 1, 2) = "2 " Or Mid(Adresse, 1, 2) = "3 " Or Mid(Adresse, 1, 2) = "4 " _
                    Or Mid(Adresse, 1, 2) = "5 " Or Mid(Adresse, 1, 2) = "6 " Or Mid(Adresse, 1, 2) = "7 " _
                    Or Mid(Adresse, 1, 2) = "8 " Or Mid(Adresse, 1, 2) = "9 " Or Mid(Adresse, 1, 2) = "B-" Then
                        Cells(i, "E").NumberFormat = "####" ' conserver Format num
                        Worksheets("Feuil1").Range("E" & i) = Var1
                        Worksheets("Feuil1").Range("F" & i) = Mid(Adresse, 1, 1)
                        Adresse = Right(Adresse, Len(Adresse) - 2)
                        Adresse = LTrim(Adresse)
                        Worksheets("Feuil1").Range("G" & i) = Adresse
                    End If
                    ' Traitement si Bis ou Ter sur numro à 2 chiffres
                    If Mid(Adresse, 1, 3) = "BIS" Or Mid(Adresse, 1, 3) = "TER" Or Mid(Adresse, 1, 3) = "B/T" _
                    Or Mid(Adresse, 1, 3) = "Bis" Or Mid(Adresse, 1, 3) = "Ter" Then
                        Cells(i, "E").NumberFormat = "####" ' conserver Format num
                        Worksheets("Feuil1").Range("E" & i) = Var1
                        Worksheets("Feuil1").Range("F" & i) = Mid(Adresse, 1, 3)
                        Adresse = Right(Adresse, Len(Adresse) - 4)
                        Adresse = LTrim(Adresse)
                        Worksheets("Feuil1").Range("G" & i) = Adresse
                    End If
                    
                                
                End If
                ' *******************************************
                ' Traitement de numéro de rue à 3 chiffres
                ' *******************************************
                
                If (Val(Var2) > 99 And Val(Var2) <= 999) And Mid(Adresse, 4, 1) = " " Then
                    Cells(i, "E").NumberFormat = "####" ' conserver Format num
                    Worksheets("Feuil1").Range("E" & i) = Var2
                    Adresse = Right(Adresse, Len(Adresse) - 3)
                    Adresse = LTrim(Adresse)
                    Worksheets("Feuil1").Range("G" & i) = Adresse
                    ' Traitement si B pour Bis sur numéro à 3 chiffres
                    If Mid(Adresse, 1, 2) = "B " Or Mid(Adresse, 1, 2) = "C " Or Mid(Adresse, 1, 2) = "D " _
                    Or Mid(Adresse, 1, 2) = "E " Or Mid(Adresse, 1, 2) = "F " Or Mid(Adresse, 1, 2) = "G " _
                    Or Mid(Adresse, 1, 2) = "H " Or Mid(Adresse, 1, 2) = "I " Or Mid(Adresse, 1, 2) = "Q " _
                    Or Mid(Adresse, 1, 2) = "T " Or Mid(Adresse, 1, 2) = "A " Then
                        Cells(i, "E").NumberFormat = "####" ' conserver Format num
                        Worksheets("Feuil1").Range("E" & i) = Var1
                        Worksheets("Feuil1").Range("F" & i) = Mid(Adresse, 1, 1)
                        Adresse = Right(Adresse, Len(Adresse) - 2)
                        Adresse = LTrim(Adresse)
                        Worksheets("Feuil1").Range("G" & i) = Adresse
                    End If
                    ' Traitement si Bis ou Ter sur numro à 3 chiffres
                    If Mid(Adresse, 1, 3) = "BIS" Or Mid(Adresse, 1, 3) = "TER" Or Mid(Adresse, 1, 3) = "B/T" _
                    Or Mid(Adresse, 1, 3) = "Bis" Or Mid(Adresse, 1, 3) = "Ter" Then
                        Cells(i, "E").NumberFormat = "####" ' conserver Format num
                        Worksheets("Feuil1").Range("E" & i) = Var1
                        Worksheets("Feuil1").Range("F" & i) = Mid(Adresse, 1, 3)
                        Adresse = Right(Adresse, Len(Adresse) - 4)
                        Adresse = LTrim(Adresse)
                        Worksheets("Feuil1").Range("G" & i) = Adresse
                    End If
                End If
                ' ***************************************
                ' Traitement numéro de rue à 4 chiffres
                ' ***************************************
                If Val(Var3) >= 1000 And Mid(Adresse, 5, 1) = " " Then
                    Cells(i, "E").NumberFormat = "####" ' conserver Format num
                    Worksheets("Feuil1").Range("E" & i) = Var4
                    Adresse = Right(Adresse, Len(Adresse) - 4)
                    Adresse = LTrim(Adresse)
                    Worksheets("Feuil1").Range("G" & i) = Adresse
                End If
                
                ' Si le dernier caractère égal - alors supprime -
                If Mid(Adresse, 1, 1) = "-" Then
                    Adresse = Right(Adresse, Len(Adresse) - 1)
                    Adresse = LTrim(Adresse)
                    Worksheets("Feuil1").Range("G" & i) = Adresse
                End If
                      
            End If
            
    
            ' Centre le numéro de rue à droite
            Worksheets("Feuil1").Range("F" & i).Select
            With Selection
                .HorizontalAlignment = xlRight
                .VerticalAlignment = xlCenter
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
            
            
            
            
            
            i = i + 1
            
        Next
        
    End With
    
    Unload UserForm1
    Columns("L:L").Hidden = True
    ' Tri multi critères (Communes + Adresses + Num Rues + Producteurs )
    Call TriBacs
    ' Préparation de l'impression
    Call Imprimer
    
    Set FL1 = Nothing
    Set Plage = Nothing
    
    
End Sub

Sub importation()
'
' importation Macro
'
' Ouvrir le fichier export.xls avant de réaliser l'importation
' Thierry
Application.CutCopyMode = False
' Ouverture du fichier
Dim cheminfichier As String
cheminfichier = ThisWorkbook.Path & "\Export.xls"
Workbooks.Open Filename:=cheminfichier
    
' Importation

    Cells.Select
    Selection.Copy
    
    Windows("AmbassadeurSensibilisation.xlsm").Activate
    Cells.Select
    ThisWorkbook.Sheets("feuil1").[A1].PasteSpecial
    Range("A2").Select
 
    Call Macro7
    ' ferme le fichier export
    Workbooks("Export.xls").Close False
    Application.CutCopyMode = False
    

End Sub
Sub Macro7()
'
' Macro7 Macro
' Thierry
Application.CutCopyMode = False
'

    Columns("C:C").Delete Shift:=xlToLeft
    Columns("D:D").Delete Shift:=xlToLeft
    Columns("I:I").Delete Shift:=xlToLeft
    Columns("D:D").ColumnWidth = 34.14
    Columns("E:E").ColumnWidth = 40.14
    Columns("G:G").ColumnWidth = 28.29
    Columns("H:H").ColumnWidth = 50
    
    Rows("1:1").Font.Bold = True
    Range("A2").Select
End Sub

 

[TVulcain]

L'objet de la discussion, n'a plus d'objet par rapport au titre, donc si j'ai un autre souci, je préfère créer un autre sujet

 

[Staple1600]

Re

Apparemment ma version de ta macro Macro7 ne t’intéresse pas...
(cf le message#46)
Dans ce cas, à quoi cela sert-il que je me décarcasse...

•Tu n'as pas le temps de supprimer tout les Select qu'on peut encore lire dans tes macros ?

 

[TVulcain]

Je le fais au fur et à mesure, et pour ta macro je l'ai copié dans le code pour la tester.
Ne t'inquiéte pas je prends tes conseils au sérieux, ce n'est pas en vain

 

[Staple1600]

Re

OK
Donc si tu remanies ton code en supprimant un max de Select et Activate (quand cela est possible) normalement tu devrais déjà voir une différence au niveau du temps d’exécution.

Et comme tu l'as si bien dit, il est temps d'ouvrir un nouvelle discussion car effectivement depuis le message#13, on est plus raccord avec le titre de cette discussion.

 

[TVulcain]

Nous sommes en accord oui, le code actuellement est rapide
merci pour tes conseils, j'ai appris