Macros et Userform

[Claude]

Le 18 03 j'avais posté:

Auteur: Claude (---.abo.wanadoo.fr)
Date: 18-03-03 15:19

Comment modifier les macros et userform de plusieurs classeurs sans les passer un par un

J'ai constuit un modele de classeur avec un userform et des macros.
Au fil du temp j'ai amelioré et / ou simplifié mes macros.Comment mettre à jour les classeurs deja enregistrés sans avoir à les passer un âpres l'autre ?
J'ai plus de 500 enregistrements Stockés dans un même dossier.

Merci

N'ayant aucune aide je repause la question

Y aurait il une ame charitable pour venir a mon secours ?

Meci d'avance à tous

 

[Baroude]

Hello le forum et Claude,

Il existe une possibilité d'exporter les modules et les userforms en faisant un clic droit sur le module ou la USF, puis clic sur "Exporter un fichier". Cela permet d'enregistrer sur le disque dur un fichier BAS pour les modules et FRM pour les Userforms.

A partir d'un autre fichier Excel, dans VBA en faisant "Fichier - Importer un fichier" on peut récupérer les modules et USF.

Dans tous les cas, il faudra quand même faire tous les fichiers un par un... mais ça peut réduire quelques manipulations.

Bonne journée
Baroude

 

[Claude]

je vais mamuser ??

dur dur

merci pour la reponse

 

[Zon]

Bonsoir Claude, j'ai peut être une solution moins éprouvante que celle de Baroude,

En effet le classeur où sont toutes macros, il lui suffit de lui supprimer toutes ses feuilles sauf la première puis avec le code suivant on va chercher le fichier dont on copie toutes ses feuilles dans le classeur original, puis on supprime la premiere feuille, il ne reste plus qu'à sauvegarder. on a toute les macros


Sub import()
Dim i As Integer
Dim reponse As String
For i = Sheets.Count To 2 Step -1
Application.DisplayAlerts = False
Sheets(i).Delete
Next i

filetoopen = Application.GetOpenFilename("Excel fichiers (*.xls), *.xls")
If filetoopen <> False Then
Workbooks.Open (CStr(filetoopen))
End If
For i = 1 To ActiveWorkbook.Sheets.Count
Sheets(i).Copy After:=Workbooks("test.xls").Sheets(1)
Next i
Workbooks("test.xls").Sheets(1).Delete
reponse = InputBox("NOM du fichier")
Workbooks("test.xls").SaveCopyAs (reponse)

End Sub

Attention aux noms de feuille !!! car je n'ai pas testé le

A+++

 

[Zon]

Re j'ai oublié les commentaires de mon code


Bien sûr Workbooks("test.xls") est à adpater c'est le nom du classeur où sont toutes les macros.


Bien sûr, si tu ne veux pas relancer la ma cro à chaque fois

tu tapes 1 avant la ligne For i = Sheets.Count To 2 Step -1
puis Goto 1 avant le end sub, cela fait une boucle si tu veux arrêter la macro (hors bug éventuels !!!!! ), tu n'ouvres pas de nouveau fichier


A tester....

 

[Claude]

Merci
grace a toi j'ai reussi

j'ai mis ta macro à ma sauce
ce n'est peut etre pas trop dans les regles mais ca amrche

Sub import()
Dim i As Integer
Dim a As Integer
Dim y As Integer
Dim z As Integer
Dim x As Integer
Dim w As Integer
Dim nomfich As String
Dim Nom(1000) As Variant
Dim Dossier1 As String
Dim Dossier As String
Dim Nom2(1000) As Variant

Application.ScreenUpdating = False

Dossier = Application.GetOpenFilename("Excel fichiers (*.xls),*.xls")

'ouverture du classeur modele
Workbooks.Open Filename:="C:\Mes documents\Excel\Fiche client.xls"

' adresse du dossier contenant les classeurs a modifier
Dossier1 = "C:\Mes documents\Excel\Clients\"


'comptage et enregistrement des noms de classeur
Dossier = Dir("*.xls")

For x = 1 To 1000
Nom(x) = Dossier
If Dossier = "" Then GoTo 10
Dossier = Dir

Next x


10:
y = x - 1

MsgBox " nombres de fichiers = " & y

' ouverture modification et enregistrements des classeur
For z = 1 To y

filetoopen = Dossier1 & Nom(z)

If filetoopen <> False Then
Workbooks.Open (CStr(filetoopen))
nomfich = ActiveWorkbook.Name

End If

On Error Resume Next

For a = 1 To ActiveWorkbook.Sheets.Count
Sheets(a).Copy After:=Workbooks("Fiche client.xls").Sheets(1)
Next a

If Err <> 0 Then
Index = Index + 1
Nom2(Index) = Nom(z)
MsgBox " Nom en defaut =" & Nom(z) & vbCr & " err = " & Index & vbCr & "ligne : " & z
Workbooks(nomfich).Close savechange = False
Workbooks("Fiche client.xls").Activate
Cells.Select
Selection.ClearContents

Workbooks("Fiche client.xls").Close savechange = False
Workbooks.Open Filename:="C:\Mes documents\Excel\Fiche client.xls"
On Error GoTo 0
GoTo 20

End If

On Error GoTo 0
Application.DisplayAlerts = False
Workbooks(nomfich).Close savechange = False
Workbooks("Fiche client.xls").Sheets(1).Delete
Workbooks("Fiche client.xls").Sheets(1).Name = "Feuil1"

Workbooks("Fiche client.xls").SaveCopyAs Filename:=Dossier1 & nomfich

20:
Application.CutCopyMode = False
Next z

'report des erreurs
Workbooks(depart).Activate

Range("a1").Select

For w = 1 To Index
ActiveCell.Offset(w, 0) = Nom2(w)

Next w

Application.DisplayAlerts = True
Application.ScreenUpdating = True


End Sub


en la mettant dans un classeur vide (classeur1.xls)

j'ai passe 563 classeurs en 4 mn 40

seul hic

des erreurs tout les +- 180 fichiers

c'est pourquoi je recharge le modele

m'enfin ca marche

YOUPI !!!