IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

copier une feuille excel vers un autre fichier excel en access VBA


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre confirmé
    Femme Profil pro
    Consultante informatique décisionnelle et bases de données
    Inscrit en
    Décembre 2007
    Messages
    82
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Âge : 59
    Localisation : France, Sarthe (Pays de la Loire)

    Informations professionnelles :
    Activité : Consultante informatique décisionnelle et bases de données

    Informations forums :
    Inscription : Décembre 2007
    Messages : 82
    Par défaut copier une feuille excel vers un autre fichier excel en access VBA
    Bonjour,

    J'utilise Office 2003 SP3.
    A partir d'une base Access, je souhaite copier une feuille excel vers un autre fichier excel.

    Voici mon code :

    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
    Private Sub cmdxls_Click()
    On Error GoTo Err_cmdxls_Click
    Dim xlApp1 As Excel.Application
    Dim xlsheet1 As Excel.Worksheet
    Dim xlBook1 As Excel.Workbook
    Dim xlApp2 As Excel.Application
    Dim xlsheet2 As Excel.Worksheet
    Dim xlBook2 As Excel.Workbook
     
    Set xlApp1 = CreateObject("Excel.Application")
    Set xlBook1 = xlApp1.Workbooks.Open("C:\Mes documents\donneesdepart.xls")
    Set xlsheet1 = xlBook1.Worksheets("Input")
    Set xlApp2 = CreateObject("Excel.Application")
    Set xlBook2 = xlApp2.Workbooks.Open("C:\Mes documents\resultat.xls")
     
    xlsheet1.Copy after:=xlBook2.Worksheets(xlBook2.Worksheets.Count)
     
    xlApp1.Quit
    xlApp2.Quit
    Set xlBook1 = Nothing
    Set xlApp1 = Nothing
    Set xlsheet1 = Nothing
    Set xlBook2 = Nothing
    Set xlApp2 = Nothing
     
     
    Exit_cmdxls_Click:
        Exit Sub
     
    Err_cmdxls_Click:
        MsgBox Err.Description
        Resume Exit_cmdxls_Click
     
    End Sub
    Lorsque j'exécute mon code, il m'affiche :
    La méthode 'Copy' de la classe '_worksheet' a échoué.

    Cela fait 2 heures que je recherche une solution sur ce site, sans résultat...
    Quelqu'un(e) peut m'aider, SVP merci ?

    Anne

  2. #2
    Membre confirmé
    Femme Profil pro
    Consultante informatique décisionnelle et bases de données
    Inscrit en
    Décembre 2007
    Messages
    82
    Détails du profil
    Informations personnelles :
    Sexe : Femme
    Âge : 59
    Localisation : France, Sarthe (Pays de la Loire)

    Informations professionnelles :
    Activité : Consultante informatique décisionnelle et bases de données

    Informations forums :
    Inscription : Décembre 2007
    Messages : 82
    Par défaut
    Eureka,

    J'ajoute une feuille dans mon classeur de destination (fonction trouvée sur ce site) :

    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
     
    Public Sub ajoutfeuillexls(schemin As String, snomfeuille As String)
    Dim xlappf As Excel.Application
    Dim xlbookf As Excel.Workbook
     
    Set xlappf = CreateObject("Excel.Application")
    Set xlbookf = xlappf.Workbooks.Open(schemin)
     
    xlbookf.Worksheets.Add
     
    xlbookf.Worksheets("Feuil1").Name = snomfeuille
    xlbookf.Save
    xlappf.Quit
    Set xlappf = Nothing
    Set xlbookf = Nothing
     
    End Sub
    puis je copie les valeurs à l'aide d'un objet 'Range'. L'inconvénient, c'est que cela copie uniquement les valeurs mais pas la mise en forme.

    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
     
    Private Sub cmdxls_Click()
    On Error GoTo Err_cmdxls_Click
    Dim xlApp1 As Excel.Application
    Dim xlsheet1 As Excel.Worksheet
    Dim xlBook1 As Excel.Workbook
    Dim xlvalue1 As Range
    Dim xlApp2 As Excel.Application
    Dim xlsheet2 As Excel.Worksheet
    Dim xlBook2 As Excel.Workbook
    Dim xlvalue2 As Range
    Dim AdresseAbsolue As String
    Dim i As Integer
     
    KillProcess "Excel.Exe"
     
    ajoutfeuillexls "C:\test\resultat.xls", "Input"
     
    Set xlApp1 = CreateObject("Excel.Application")
    Set xlBook1 = xlApp1.Workbooks.Open("C:\test\donneesdepart.xls")
    Set xlsheet1 = xlBook1.Worksheets("Input")
    xlsheet1.Unprotect
    i = xlsheet1.Range("A1").SpecialCells(xlCellTypeLastCell).Row
    Set xlvalue1 = xlsheet1.Range("A1:V" & i)
     
    Set xlApp2 = CreateObject("Excel.Application")
    Set xlBook2 = xlApp2.Workbooks.Open("C:\test\resultat.xls")
    Set xlsheet2 = xlBook2.Worksheets("Input")
    Set xlvalue2 = xlsheet2.Range("A1:V" & i)
     
    xlvalue2.Value = xlvalue1.Value
     
    xlBook2.Save
    xlBook1.Close (False)
    xlApp1.Quit
     
    xlApp2.Quit
    Set xlvalue1 = Nothing
    Set xlBook1 = Nothing
    Set xlApp1 = Nothing
    Set xlsheet1 = Nothing
    Set xlvalue2 = Nothing
    Set xlsheet2 = Nothing
    Set xlBook2 = Nothing
    Set xlApp2 = Nothing
     
     
    Exit_cmdxls_Click:
        Exit Sub
     
    Err_cmdxls_Click:
        MsgBox err.Description & " " & err.Number
        Resume Exit_cmdxls_Click
     
    End Sub
    En prime, la fonction Killprocess (fonction trouvée sur ce site) que j'utilise pour vérifier qu'aucune instance Excel n'est déjà ouverte.

    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
     
    Public Function KillProcess(ByVal ProcessName As String) As Boolean
    On Error GoTo err
        Dim svc As Object
        Dim sQuery As String
        Dim oproc
        Set svc = GetObject("winmgmts:root\cimv2")
        sQuery = "select * from win32_process where name='" & ProcessName & "'"
        For Each oproc In svc.execquery(sQuery)
            oproc.Terminate
        Next
        Set svc = Nothing
    err:
    Set svc = Nothing
    'MsgBox err.Description & " " & err.Number & " " & err.Source
    End Function

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Réponses: 0
    Dernier message: 12/05/2015, 16h25
  2. [XL-2007] Envoyer des données d'un fichier excel vers un autre fichier
    Par Langelusyfaire dans le forum Excel
    Réponses: 24
    Dernier message: 22/04/2014, 11h19
  3. [XL-2007] Macro: comment importer des valeurs de fichiers Excel vers un autre fichier Excel?
    Par jerdel dans le forum Macros et VBA Excel
    Réponses: 3
    Dernier message: 06/03/2012, 16h23
  4. copier une feuille graphique vers un autre classeur en vba
    Par rob1son76 dans le forum Macros et VBA Excel
    Réponses: 1
    Dernier message: 04/03/2011, 17h53
  5. Copier fichiers excel vers un autre fichier
    Par bb62 dans le forum Macros et VBA Excel
    Réponses: 5
    Dernier message: 07/10/2008, 16h15

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo