Accueil > Forum > > > > Erreur d'execution '1004' mais sur Excel 2007
 Erreur d'execution '1004' mais sur Excel 2007
mardi 18 décembre 2007 à 10:44:20 |
Erreur d'execution '1004' mais sur Excel 2007
kgadhi
|
Bonjour tous le monde et merci d'avance pour votre aide, J'ai développé une macro qui permet de mettre à jour un fichier excel depuis un autre fichier. Je travaille sous excel 2003. Aprés plusieurs tentatives, la macro marche. Apres j'ai voulu afficher le fichier sous excel 2007 et la j'ai l'erreur suivante : Erreur d'execution '1004' : Excel ne parvient pas à insérer les feuilles dans le classeur de destination car il contient moins de lignes et de colonnes que le classeur source. Pour déplacer ou copier les données vers le classeur de destination, vous pouvez les selectionner, puis utiliser les commandes Copier et Coller pour les insérer dans les feuilles d'un autre classeur.
Je vous mets aussi le code source
<code source>
' Récuperer le nom du rep courant
nomRepCourant = ThisWorkbook.Path
longueur = Len(nomRepCourant)
If longueur > 0 Then
pos = InStr(nomRepCourant, "\")
' MsgBox nomRepCourant & " " & pos
If (pos <> 0) Then
trouve = True
While trouve
longueur = Len(nomRepCourant)
nomRepCourant = Right(nomRepCourant, longueur - pos)
pos = InStr(nomRepCourant, "\")
' MsgBox "rep1 : " & nomRepCourant & " " & pos
If (pos = 0) Then
trouve = False
End If
Wend
End If
End If
' MsgBox "Fichier: " & nomRepCourant
' Le nom du fichier
Fichier = nomRepCourant & ".txt"
nomFichier = nomRepCourant
CheminFichier = CheminFichier & "\" & Fichier
' MsgBox "Fichier: " & CheminFichier
NbEntrAjout = 0
NbEntrSupp = 0
Application.ScreenUpdating = False
If Dir(CheminFichier) <> "" Then
' Ouvrir et lire le fichier
Workbooks.OpenText Filename:=CheminFichier, Origin:= _
xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _
, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=True, Comma:=False _
, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
Array(10, 1)), TrailingMinusNumbers:=True
Sheets(nomFichier).Select
' MsgBox "fichier : " & nomFichier
Sheets(nomFichier).Move After:=Workbooks("SUIVI DES VISIT¦'ENTREPRISE.xls").Sheets(1) L'erreur est à cette ligne
' Compter le nombre de lignes recupérées
Open CheminFichier For Input As #1
While Not EOF(1)
Line Input #1, Texte
NbLignes = NbLignes + 1
Wend
Close #1
Lignes = 0
' Verifier l'existance de la feuille modPortefeuille
If FeuilleExiste(ThisWorkbook, "modPortefeuille") Then ' La feuille existe donc on la vide
Sheets("modPortefeuille").Select
ActiveSheet.Shapes.SelectAll
Selection.Delete
ActiveSheet.Cells.Clear
Else ' On ajoute la feuille
Sheets.Add
ActiveSheet.Name = "modPortefeuille"
Sheets("modPortefeuille").Select
Sheets("modPortefeuille").Move Before:=Sheets(4)
End If
Range("C3:F3").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
ActiveCell.FormulaR1C1 = "Les entreprises ajoutées"
Range("J3:M3").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
ActiveCell.FormulaR1C1 = "Les entreprises supprimées"
Sheets("Suivi des visites entreprise").Select
Range("B4:G4").Select
Selection.Copy
Sheets("modPortefeuille").Select
Range("B4").Select
ActiveSheet.Paste
Range("I4").Select
ActiveSheet.Paste
Range("C3:F3").Select
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Range("J3:M3").Select
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Range("B5").Select
Sheets(nomFichier).Select
' MsgBox "nbrelignes : " & NbLignes
For i = 1 To NbLignes + 1
DoEvents
RefAMI = Cells(i, 1).Value
' MsgBox "i : " & i & " , RefAmi : " & RefAMI
If Cells(i, 9).Value = "" Then 'Ajout de la ligne
Sheets("Suivi des visites entreprise").Select
' Verifier que le Ref Ami n'existe pas deja dans la liste
TrouveRef = False
For j = 1 To ActiveSheet.UsedRange.Rows.Count + 1
If Cells(j, 2).Value = RefAMI Then
TrouveRef = True
End If
Next j
' Ajouter la ligne
If TrouveRef = False Then
Sheets(nomFichier).Select
Lignes = Lignes + 1
Range(Cells(i, 1), Cells(i, 8)).Select
Selection.Copy
Sheets("Suivi des visites entreprise").Select
Range("B65536").End(xlUp).Offset(1, 0).PasteSpecial
' Cadrer
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End If
NbEntrAjout = NbEntrAjout + 1
Sheets(nomFichier).Select
Range(Cells(i, 1), Cells(i, 6)).Select
Selection.Copy
Sheets("modPortefeuille").Select
Range(Cells(NbEntrAjout + 4, 2), Cells(NbEntrAjout + 4, 2)).Select
ActiveSheet.Paste
' Cadrer
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Sheets(nomFichier).Select
Else ' Suppression de la ligne
Sheets("Suivi des visites entreprise").Select
For j = 1 To ActiveSheet.UsedRange.Rows.Count
If Cells(j, 2).Value = RefAMI Then
Cells(j, 1).EntireRow.Delete
'Range(Trim(Str(ActiveCell.Row)) & ":" & Trim(Str(ActiveCell.Row))).Select
'Selection.Delete Shift:=xlUp
End If
Next j
NoLgnFin = ActiveSheet.UsedRange.Rows.Count
' MsgBox "Nb de ligne du fichier modPortefeuilleMed.txt : " & NoLgnFin
NbEntrSupp = NbEntrSupp + 1
Sheets(nomFichier).Select
Range(Cells(i, 1), Cells(i, 6)).Select
Selection.Copy
Sheets("modPortefeuille").Select
Range(Cells(NbEntrSupp + 4, 9), Cells(NbEntrSupp + 4, 9)).Select
ActiveSheet.Paste
' Cadrer
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Sheets(nomFichier).Select
End If
Next i
'Sheets("modPortefeuilleMed").Select
'ActiveSheet.Shapes.SelectAll
'Selection.Delete
'ActiveSheet.Cells.Clear
Application.CutCopyMode = False
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
' MsgBox "Nb de ligne: " & Lignes
'Range("B5").CurrentRegion.Rows(Range("B5").CurrentRegion.Rows.Count).Copy
'Range("B65536").End(xlUp).Offset(1, 0).PasteSpecial
'Selection.ClearContents
End If
' Sheets("Suivi des visites entreprise").Select
Sheets("modPortefeuille").Select
Application.ScreenUpdating = True
End Sub
</code source> Et le probleme c'est que sous excel 2003 ça marche tres bien. Je suis débutant en vba. |
|
mardi 18 décembre 2007 à 11:18:34 |
Re : Erreur d'execution '1004' mais sur Excel 2007
MPi
|
Comme le message te l'indique, pourquoi ne pas utiliser le copier/coller plutôt que Move ?
Est-ce que les 2 classeurs ont le même nombre de lignes et de colonnes ? Je pense que la version 2007 a beaucoup plus de colonnes et de lignes que les versions précédentes. Il y donc peut-être conflit entre tes 2 classeurs à ce niveau (?)
MPi²
|
|
Cette discussion est classée dans : end, selection, with, borders, linestyle
 Répondre à ce message
 Sujets en rapport avec ce message
Mise ene page excel a partir de VB(macro) [ par titto7 ]
Bonjour ,J'ai une probleme sur la mise en page d'excel apres l'avoir rempli a partir de vb.je souhaite (une fois la page excel remplie) faire sa mise
Problème macro activation cellule [ par nanotechno ]
Bonjour, J'ai un problème sur ma macro.Ma macro ci dessous est correcte. Cependant, elle ne marche que si je me positionne en A8 et puis que je réali
[Déplacé VBS --> VBA] html ou css dans une macro??? [ par kromei ]
bonjour je travaille sur une appli excel qui a un existant et j 'aimerais que l on m explique ce que cette macro est et fait exactement;mon but est d
[Déplacé .NET -> VBA] Propriété bordure non reconnue sur une feuille protégée [ par lilou315 ]
Bonjour à tous, Je suis en train de créer un formulaire et j'aimerais que des bordures apparaissent sur une certaine cellule lorsque l'on sélectionne
aide pour un boucle [ par dauphins14 ]
[^^confus2]bonjour, actuellemnt sur excel 2003, quand je rafraichit ma base de données pour l'inserer dans une macro. Je veux que les personnes inscri
Copier un élément de l'en-tête dans word 2007 [ par gerardcjf ]
Bonjour, Je souhaite récupérer, via une macro, un élément contenu dans l'entête d'un document word. Avec l'enregistreur de macro j'ai la macro suivan
[Catégorie encore modifiée VB6 - VBA] CONDITIONNER L EXECUTION D'UNE MACRO PAR UN MOT DE PASSE [ par champi210781 ]
Bonjour à tous Dans mon projet, j'ai réalisé le code suivant qui demande un mot de passe pour l'éxécution de ma boucle si celui ci est bon la boucle
[Catégorie modifiée VB6 --> VBA] CREATION GRAPHIQUE [ par RLAGUE ]
bonjour a tous voici mon probleme je veux creer des graphiques en prenant des donnees dans un tableau. jusque là cela se passe bien! je n'arrive pas
Excel 2003 : Erreur 91 [ par toufous ]
Bonjour à tous! Bon voila suite à mon autre post, j'ai créer ce code: [code=vb]Private Sub CommandButton1_Click() Dim CelD As Range Dim CelF As Rang
 Livres en rapport
|
Derniers Blogs
 GESTION D'EXCEPTION AVEC LES TASKSGESTION D'EXCEPTION AVEC LES TASKS par richardc
Nous avons vu dans un précédent article comment utiliser Task pour effectuer des opérations dans un autre thread.
Malheureusement, comme tout le monde n'est pas parfait, il se peut que cette exécution se passe mal et qu'une exception se produise.
La...
Cliquez pour lire la suite de l'article par richardc DéMARRONS AVEC LES TASKSDéMARRONS AVEC LES TASKS par richardc
Que vous le vouliez ou non, le développement multi-tâche est maintenant une obligation pour toute nouvelle application. Il est donc vital d'en comprendre les mécanismes et de s'y mettre le plus tôt possible.
En attendant le .NET Framework 4.5 avec le...
Cliquez pour lire la suite de l'article par richardc SLIDE & DéMO TECHDAYS 2012 - FAST & FURIOUS XAML APPSSLIDE & DéMO TECHDAYS 2012 - FAST & FURIOUS XAML APPS par Vko
Retrouvez les slides et les démo de ma session Fast & Furious XAML Apps. A ceux qui se posent la question : "est-ce que le code de la DataGrid est disponible?", je vous répondrais "pas encore". Je vais mettre en place un projet codeplex pour part...
Cliquez pour lire la suite de l'article par Vko XNA IS DEAD!XNA IS DEAD! par richardc
Depuis la semaine dernière (et grâce aux TechDays 2012), je me penche activement sur la nouvelle version de Windows, aka Windows 8. Vous me direz, il était temps puisque la première preview date de Septembre dernier.
OK. Remarquez, on n'en est qu'aux...
Cliquez pour lire la suite de l'article par richardc TECHDAYS PARIS 2012 : WINDOWS SERVER "8" QUOI DE 9 !TECHDAYS PARIS 2012 : WINDOWS SERVER "8" QUOI DE 9 ! par ROMELARD Fabrice
Speakers: Fabrice Meillon et Stanislas Quastana Cette session est basée entièrement sur celle donnée lors de la BUILD cet hiver. Il n'y a pas d'ajout d'information en rapport avec cet évènement passé. Windows 8 Server sera intégralem...
Cliquez pour lire la suite de l'article par ROMELARD Fabrice
Logiciels
 DocTranslate (V3.1.0.0)DOCTRANSLATE (V3.1.0.0)DocTranslate est un traducteur de document Microsoft Word, PowerPoint et Excel. Il permet d'autom... Cliquez pour télécharger DocTranslate Tribler (2012)TRIBLER (2012)Tribler est un client pair à pair (P2P/Peer-to-Peer) open source avec la capacité de regarder des... Cliquez pour télécharger Tribler OneSwarm (2012)ONESWARM (2012)Le peer-to-peer qui protège votre vie privée, c'est OneSwarm.
Ce logiciel de peer-to-peer crypté... Cliquez pour télécharger OneSwarm PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)PONAMEDIA TV DEVIENS HELLLOOO FLASH
LA TV SUR VOTRE ORDINATEUR.
Toute une plateforme Multi... Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO Academy System (17.2.1.0)ACADEMY SYSTEM (17.2.1.0)Logiciel de gestion des établissements.
- élèves/étudiants (inscription, dossier, absence...)
-... Cliquez pour télécharger Academy System
|