[XL-2003] lire et recopier le contenu d'un fichier excel sans l'ouvir [Résolu]

[hallscar]

Salut à tous,

Je cherche à lire un fichier (sans spécialement l'ouvir à l'écran) copier son contenu et recopier dans un autre fichier (fichier qui lance la marco)

Pouvez vous m'indiquer une méthode permettant de faire cela, car j'ai commencé avec la méthode Workbooks.Open (chemin) mais je souhaiterai m'affranchir des contraintes d'ouverture (message demandant mot de passe ou lecture seul (le fichier est protégé par mot de passe) et fermeture (demande de sauvegarde du fichier).

@+

[bbil]

Pour le principe ouverture/fermeture :

Code :

1
2
3
4
Dim wk As Workbook
 Set wk = Workbooks.Open(Filename:="c:\users\MonFich.xlsx", ReadOnly:=True, Password:="1234", IgnoreReadOnlyRecommended:=True)
 MsgBox "le fichier " & wk.Name & " est ouvert"
 wk.Close False

[Qwazerty]

Salut

Si tu fais une copie intégrale du contenu, autant faire une copie de ton fichier, quitte à supprimer quelques feuilles dans le fichier nouvellement créé.

Sinon tu peux aussi lire ce tutoriel.

++
Qwaz

[hallscar]

voila la fonction

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
Function lire_copier_fichier_Excel(Chemin As String, SheetToPaste As Integer) As Variant
'Déclaration des variables
Dim OtherBook, HomeBook As String
Dim LastRow, LastColumn As Integer
 
HomeBook = ActiveWorkbook.Name
'Ouverture d'un fichier Excel situé dans chemin en lecture seule
Workbooks.Open Chemin, , True
OtherBook = ActiveWorkbook.Name
 
ActiveWorkbook.Sheets(2).Select
Cells.Select
Selection.Copy
 
Windows(HomeBook).Activate
ActiveWorkbook.Worksheets(SheetToPaste).Select
Range("A1").Select
ActiveSheet.Paste
 
'Fermeture du classeur Excel sans sauvegarder
Application.DisplayAlerts = False
Workbooks(OtherBook).Close SaveChanges:=False
Application.DisplayAlerts = True
 
End Function

[Qwazerty]

Salut

Voila quelques modif et simplifications de ton code.

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
Function lire_copier_fichier_Excel(Chemin As String, SheetToPaste As Integer) As Variant
'Déclaration des variables
Dim OtherBook, HomeBook As Workbook
Dim LastRow, LastColumn As Integer
 
Set HomeBook = ActiveWorkbook '.Name
'Ouverture d'un fichier Excel situé dans chemin en lecture seule
OtherBook = Workbooks.Open(Chemin, , True)
'OtherBook = ActiveWorkbook.Name
 
'ActiveWorkbook.Sheets(2).Select
OtherBook.Sheets(2).UsedRange.Copy HomeBook.Worksheets(SheetToPaste).Range("A1")
'Selection.Copy
 
'Windows(HomeBook).Activate
'ActiveWorkbook.Worksheets(SheetToPaste).Select
'Range("A1").Select
'ActiveSheet.Paste
 
'Fermeture du classeur Excel sans sauvegarder
Application.DisplayAlerts = False
Workbooks(OtherBook).Close SaveChanges:=False
Application.DisplayAlerts = True
 
End Function

++
Qwaz

[hallscar]

Merci, mais je suis finalement resté sur mon code, car il y avait des erreurs engendrées, et je n'ai pas trop le temps de voir ca.

Par contre, à chaque fois que mes cellules sont collés, j'ai un message "voulez vous remplacer le contenu des cellules de destination" et je doit cliquer sur oui, une idée comment enlever cela?

[Qwazerty]

Salut

Désolé je n'avais pas testé mon code, c'est corrigé

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
Function lire_copier_fichier_Excel(Chemin As String, SheetToPaste As Integer) As Variant
'Déclaration des variables
Dim OtherBook, HomeBook As Workbook
Dim LastRow, LastColumn As Integer
 
Set HomeBook = ActiveWorkbook '.Name
'Ouverture d'un fichier Excel situé dans chemin en lecture seule
Set OtherBook = Workbooks.Open(Chemin, , True)
'OtherBook = ActiveWorkbook.Name
 
'ActiveWorkbook.Sheets(2).Select
OtherBook.Sheets(2).UsedRange.Copy HomeBook.Worksheets(SheetToPaste).Range("A1")
'Selection.Copy
 
'Windows(HomeBook).Activate
'ActiveWorkbook.Worksheets(SheetToPaste).Select
'Range("A1").Select
'ActiveSheet.Paste
 
'Fermeture du classeur Excel sans sauvegarder
Application.DisplayAlerts = False
OtherBook.Close SaveChanges:=False
Application.DisplayAlerts = True
 
End Function

Pour les messages, tu utilises déjà la solution, c'est DisplayAlerts, en encadrant le code générant un message, tu empêches que celui-ci soit affiché.

Bonne soirée

++
Qwaz

[hallscar]

Le code fonctionne parfaitement,
seul hic, la largeur des colonnes n'est pas retranscrite, j'ai essayé un ajustement automatique des colonnes, mais c'est pas bon ca répond pas au besoin.

[bbil]

bonjour,

modifie ton code pour copier la feuille plutôt que les cellules..


pense aussi à corriger tes déclarations :

Code :

Dim LastRow, LastColumn As Integer

Il faut préciser le type pour chaque variables ... !

[Qwazerty]

Envoyé par bbil

[...]
pense aussi à corriger tes déclarations :

Code :

Dim LastRow, LastColumn As Integer

Il faut préciser le type pour chaque variables ... !

Salut
... exact, je suis passé à coté...
++
Qwaz

[hallscar]

merci des conseilles, mais nouvelle façon de faire, nouveau problème...
La mise en forme est bien respectée. Par contre le fait de copie-coller une feuille me créé une nouvelle feuille dans mon fichier excel "racine" alors que mon besoin est :
lire le nom de la feuille dans mon fichier "racine", chercher un fichier Excel ayant le nom de la feuille sélectionnée dans les sous répertoires ou se trouve mon fichier excel "racine", une fois trouvé le fichier excel "cible" copier son contenu et le recopier dans la feuille de mon fichier "racine" SANS RAJOUTER OU MODIFIER LE NOM DE CELLE-CI.
Une astuce?

voici mon code :

Code :

OtherBook.Sheets(OB_SheetToCopy).Copy HomeBook.Worksheets(HB_SheetToPaste)

J'ai testé avec Move, même résultat

Nota : mes fonctions de recherche de fichier... son déjà bien avancées il reste cette fonction copier/coller à terminer.

[Qwazerty]

Salut
Essai comme ça

Code :

1
2
3
4
5
6
7
8
9
10
11
Dim aColonne As Integer
 
OtherBook.Sheets(OB_SheetToCopy).Copy HomeBook.Worksheets(HB_SheetToPaste)
 
With OtherBook.Sheets(OB_SheetToCopy)
    'On boucle sur chaque colonne
    For aColonne = 1 To .UsedRange.Column + .UsedRange.Columns.Count - 1
        'On attribue le même largeur a chaque colonne
        HomeBook.Worksheets(HB_SheetToPaste).Columns(aColonne).Width = .Columns(aColonne).Width
    Next
End With

++
Qwaz

[hallscar]

Terminé, Merci beaucoup à toi qwaz!! Columns(aColonne).Width ne fonctionne pas, c'est Columns(aColonne).ColumnWidth

la fonction au final:

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
Function lire_copier_fichier_Excel(Chemin As String, OB_SheetToCopy As Integer, HB_SheetToPaste As Integer)
'Déclaration des variables
Dim OtherBook As Workbook, HomeBook As Workbook
Dim LastRow As Integer, LastColumn As Integer, aColonne As Integer, aRow As Integer
 
Set HomeBook = ActiveWorkbook '.Name
'Ouverture d'un fichier Excel situé dans chemin en lecture seule
Set OtherBook = Workbooks.Open(Chemin, , True)
'OtherBook = ActiveWorkbook.Name
 
'Copie la feuille sélectionnée dans OtherBook et la colle dans la feuille sélectionnée de HomeBook (nota : les largeurs de colonnes ne sont pas retranscrites)
OtherBook.Sheets(OB_SheetToCopy).UsedRange.Copy HomeBook.Worksheets(HB_SheetToPaste).Range("A1")
 
'Boucle pour ajuster les hauteurs de lignes de la feuille HomeBook à l'identique de la feuille OtherBook
 With OtherBook.Sheets(OB_SheetToCopy)
    'On boucle sur chaque ligne
    For aRow = 1 To .UsedRange.Row + .UsedRange.Rows.Count - 1
        'On attribue le même largeur a chaque ligne
        HomeBook.Worksheets(HB_SheetToPaste).Rows(aRow).RowHeight = Rows(aRow).RowHeight
    Next
End With
'Boucle pour ajuster les largeurs des colonnes de la feuille HomeBook à l'identique de la feuille OtherBook
 With OtherBook.Sheets(OB_SheetToCopy)
    'On boucle sur chaque colonne
    For aColonne = 1 To .UsedRange.Column + .UsedRange.Columns.Count - 1
        'On attribue le même largeur a chaque colonne
        HomeBook.Worksheets(HB_SheetToPaste).Columns(aColonne).ColumnWidth = Columns(aColonne).ColumnWidth
    Next
End With
 
'Fermeture du classeur Excel sans sauvegarder
Application.DisplayAlerts = False
OtherBook.Close SaveChanges:=False
Application.DisplayAlerts = True
 
End Function

Il ne me reste plus qu'à terminer ma fonction de recherche de fichiers ici, et tout mon programme sera terminé...