Salut Avyrex1926
Essaie avec cette exemple ci
Le fichier.xls doit exister avant l'appel de cette fonction et toutes les cellules sont vides au départ
Si il n'y a qu'une seule feuille Excel utilisée tu peux supprimer la création des feuilles supplémentaires
Attention toutes les feuilles sont identiques au départ si il y a plusieurs feuilles
Dim nbsheet As Long, nbfeuille as Long
Dim appExcel As Object
Dim wbExcel As Object
Dim wsExcel As Object
On Error GoTo Erreurfich
fichname$ = "fichier.xls" ' ce fichier est vide de toute donnée : seules les formats, couleurs et propriétés des cellules sont déjà définies
Close ' ferme tous les fichiers ouverts
'Ouverture de l'application
Set appExcel = CreateObject("Excel.Application")
'Ouverture d'un fichier Excel
Set wbExcel = appExcel.Workbooks.Open(fichname$)
If wbExcel.ReadOnly Then
MsgBox "Ce fichier Excel est déjà ouvert dans une autre application : exportation annulée"
Set appExcel = Nothing
Set wbExcel = Nothing
Exit Sub
End If
' On ne laisse que la première feuille du classeur
With wbExcel
nbsheet& = .Sheets.Count ' nombre de feuilles de ce classeur
If nbsheet& > 1 Then
For i& = .Sheets.Count To 2 Step -1 ' on supprime les feuilles en partant de la dernière
nomfeuille$ = .Sheets(i&).Name
appExcel.DisplayAlerts = False ' pas de boite d'alerte
appExcel.Worksheets(nomfeuille$).Delete ' suppression de la feuille
appExcel.DisplayAlerts = True
Next i&
End If
.Sheets(1).Name = "Feuil1" ' on renomme la première feuille : l'utilisateur peut avoir changé ce nom sous Excel
End With
' Calcul et création du nombre de feuilles nécessaires ( si plusieurs feuilles identiques)
nbfeuille& = 5 ' ici en exemple : 5 feuilles
' On crée les feuilles supplémentaires
If nbfeuille& > 1 Then
With wbExcel
For i& = 2 To nbfeuille&
nomfeuille$ = "Feuil" & .Sheets.Count ' nom de la feuille à copier
.Sheets(nomfeuille$).Copy After:=.Sheets(.Sheets.Count) ' copie de la feuille après
nomfeuille$ = "Feuil" & .Sheets.Count ' nom de la feuille copiée
.Sheets(i&).Name = nomfeuille$ ' on la renomme
.Sheets(nomfeuille$).Select
Next i&
End With
End If
For j& = 1 To nbfeuille&
Set wsExcel = wbExcel.Worksheets(j&) ' Feuille courante
appExcel.Visible = True ' Rend l'application Excel visible
With wsExcel
.Cells(1,5) = "Texte à insérer dans la cellule définie par les valeurs ligne et colonne sur le feuille courante) ' LA LIGNE LA PLUS IMPORTANTE
.Cells(6,8) = "Texte à insérer dans la cellule définie par les valeurs ligne et colonne sur le feuille courante : ligne et colonne peuvent être des variables)
End With
Next j&
wbExcel.save ' sauvegarde le fichier Execl
appExcel.Quit ' on ferme Excel
Set appExcel = Nothing
Set wbExcel = Nothing
Set wsExcel = Nothing
Exit Sub
Erreurfich:
MsgBox "Erreur dans l'exportation", vbCritical
appExcel.Quit
Set appExcel = Nothing
Set wbExcel = Nothing
Set wsExcel = Nothing
End Sub
La théorie, c'est quand on sait tout et que rien ne fonctionne. La pratique, c'est quand tout fonctionne et que personne ne sait pourquoi.
GRENIER Alain
