Sans reponse

[laplayast]

Bonsoir,
Aucune reponse,ai-je omis un code de conduite sur le forum,je ne sais point.
Mais une réponse,m'aurait permis d'avancer.
Voici ma question:

Je viens de créer,une macro qui efface les cellules bleues après la création de la feuille modèle avec un bouton.Je l'ai ajouté à la fin du code suivant;pour quelle s'exécute en automatique;mais cela ne le fait pas.
Pourriez-vous,m'aider à le mettre en place.Ci-joint le code de la macro"effacebleues" à la fin du code.
Merci à tous.laplayast@+





Option Explicit
Sub affiche1()
UserForm1.Show

End Sub

Sub creation()
Dim Sh As Worksheet
Dim i As Integer
Dim j As Integer
Dim nu() As String
Sheets("modéle").Select
With Sheets("modéle")
If .Range("D14").Value = "" Then
Call MsgBox("Vous dever indiquer le LOT ", vbInformation, Application.Name)
.Range("D14").Select
Exit Sub
End If
If .Range("H14").Value = "" Then
Call MsgBox("Vous devez indiquez le N° de PV", vbInformation, Application.Name)
.Range("H14").Select
Exit Sub
End If
If .Range("C28").Value = "" Then
Call MsgBox("Vous devez indiquez L'EPAISSEUR", vbInformation, Application.Name)
.Range("C28").Select
Exit Sub
End If
If .Range("H28").Value = "" Then
Call MsgBox("Vous devez indiquez LA FORCE", vbInformation, Application.Name)
.Range("H28").Select
Exit Sub
End If
End With
For Each Sh In Worksheets
If Sh.Name <> "modéle" Then
If InStr(Sh.Name, "modéle") > 0 Then
j = CInt(Replace(Sh.Name, "modéle", ""))
If j > i Then i = j
End If
End If
Next Sh
With Sheets("modéle")
.Copy after:=Sheets(Sheets.Count)
' On Error GoTo PbNomFeuille
ActiveSheet.Name = "modéle" & i + 1 '' référence"
End With
'
' on met les noms dans un tableau
ReDim nu(Sheets.Count)
For Each Sh In Worksheets
If Sh.Name <> "modéle" Then
If InStr(Sh.Name, "modéle") > 0 Then
j = CInt(Replace(Sh.Name, "modéle", ""))
nu(j) = Sh.Name
End If
End If
Next Sh
' on recopie les données de l'avant dernier dans le dernier
For j = UBound(nu) To LBound(nu) Step -1
If nu(j) <> "" Then
i = 1
If j > 1 Then
Do
If nu(j - i) <> "" Then Exit Do
i = i + 1
If i > Sheets.Count Then Exit Do ' sortie si problème
Loop

i = j - i
Call recopie(nu(i), nu(j))
Else
Call recopie("modéle", nu(j))
End If
End If
Next j
End Sub

Private Sub recopie(nomforig As String, nomfdest As String)
Dim £j As Integer
With Sheets(nomfdest)
'copier les cellules"H28 à H34 et I28 à I34,de la feuille modèle _
vers la feuille modèle1, vers les cellules "C28 à D34
For £j = 28 To 34
.Range("C" & £j).Value = Sheets(nomforig).Range("h" & £j).Value
.Range("D" & £j).Value = Sheets(nomforig).Range("i" & £j).Value
Next £j
' compléter pour les cellules roses
.Range("C11").Value = Sheets(nomforig).Range("C11").Value
If .Range("k14").Value = "" Then .Range("D14").Value = Sheets(nomforig).Range("D14").Value
If .Range("l14").Value = "" Then .Range("H14").Value = Sheets(nomforig).Range("H14").Value
.Range("I11").Value = Sheets(nomforig).Range("I11").Value
.Range("H36").Value = Sheets(nomforig).Range("D36").Value
End With
End Sub
Sub effacebleues()
'
' effacebleues Macro
' Macro enregistrée le 06/04/2009 par toto
'

'
Range("H28:I32,H25").Select
Range("H25").Activate
Selection.ClearContents
End Sub

 

[Excel-lent]

Re : Sans reponse

Bonsoir Laplayast, le fil,

J'ai vu, par hasard, que tu avais modifié la pièce jointe que tu avais mis en ligne dans tes premiers messages, en tenant compte de mes modif?!?! 🙂

Tu aurais pu en profiter pour corriger la présentation du reste, en te servant de l'extrait de code que je t'ai donnée 😉

J'ai profité de l'occasion pour simplifier ta macro : "EffaceBleues"

Sub effacebleues()

    Range("H28:I32").ClearContents

End Sub

Mais tu peux évidement la simplifier encore plus :

Sub effacebleues()

    [H28:I32].ClearContents

End Sub

J'ai failli pas voir que tu modifiais ta pièce jointe au fur et à mesure!!! Car je partais du dernier fichier en ligne, c'est à dire celui de Catrice! (fallait prévenir!) 😉

Voici ci-joint ton fichier corrigé!

J'en ai profité pour donner un nom plus explicite à ta UserForm, ainsi qu'à tes Command Button, TextBox, ... Cela permet de rendre ton code encore plus clair! Si tu ne connais pas la manip. et veux la connaitre? Dis le (mais sinon, tu peux également la trouver sur le forum).

Je te laisse tester ma proposition et voir si elle correspond à tes attentes.

Bonne fin de soirée

PS. : j'espère que je ne me suis pas trompé entre B1 et C11, je t'avoue que je m'y perd un peu!

 

[laplayast]

Re : Sans reponse

bonsoir,
Je n'ai pas de réponse à mon post,quelq'un peux-t-il m'apporter des précision sur la macro.
merci,à tous.
laplayast@+

 

[laplayast]

Re : Sans reponse

bonsoir,
Pas de nouvelles infos,une âme charitable pour résoudre mon problème de macro.J'espère car je suis bloqué.
merci à tous.
LAPLAYAST@+

 

[Excel-lent]

Re : Sans reponse

Bonsoir Laplayast,

Ben si!!! Regarde juste au dessus de tes deux derniers post : le post d'Excel-lent (moi-même) du 14/04/09 à 00H13!!!

A mon avis, tu n'as pas dû le voir!

Bonne soirée

 

[laplayast]

Re : Sans reponse

Bonsoir,
Effectivement,je ne l'ai pas vu.Le fichier fonctionne correctement et je t'en remercie.Pour la suite du programme,il n'est encore terminé;et je souhaiterai savoir,si tu peux travailler avec moi à la mise au point.C'est plus facile d'avoir un interlocuteur;mais cela n'enleve en rien la connaissance des autres membres.
merci encore,et en attente de te lire.😉
laplayast@+🙂

 

[laplayast]

Re : Sans reponse

Bonjour,
Je reviens,vers vous avec une première étape:
La numérotation de la cellule"C11"passe bien à la valeur suivante,à chaque création de feuille modèle;avec le bouton correspondant.Mais je voudrais,que le nom ne soit pas "modele2"mais 2=à la valeur de la cellule"C11".
Merci de votre aide.
voir fichier joint

 

[laplayast]

Re : Sans reponse

Bonjour,
Quelqu'un peut-il m'apporter,une idée à la correction du fichier au dessus.
merci.
A bientôt.
laplayast@+

 

[Excel-lent]

Re : Sans reponse

Bonsoir Laplayast,

Voici la partie de macro à modifier :

Extrait macro AVANT modification :

With Sheets("modéle")
   .Copy after:=Sheets(Sheets.Count)
[COLOR="Green"]   ' On Error GoTo PbNomFeuille[/COLOR]
   Range("C11") = Sheets(Sheets.Count - 1).Range("C11") + 1
   ActiveSheet.Name = [COLOR="Blue"]"modéle" &[/COLOR] ActiveSheet.Range("C11") [COLOR="Green"]'référence[/COLOR]
End With

Extrait macro APRES modification :

With Sheets("modéle")
   .Copy after:=Sheets(Sheets.Count)
[COLOR="Green"]   ' On Error GoTo PbNomFeuille[/COLOR]
   Range("C11") = Sheets(Sheets.Count - 1).Range("C11") + 1
   ActiveSheet.Name = ActiveSheet.Range("C11") [COLOR="Green"]'référence[/COLOR]
End With

Partie en bleu : partie à supprimer

Bonne soirée

 

[laplayast]

Re : Sans reponse

Bonjour,
Merci,de ta réponse cela fonctionne correctement;mais il y a un souci à la création de plusieurs feuilles.
Le principe tourne correctement,à chaque nouvelle feuille avec le "bouton création modéle" autant de fois que j'active celui ci;à la suite.
Si j'intercale une "feuille test",n'importe ou à la suite des autres feuilles il se produit un bug avec la numérotation.
Dans tous les cas,la "feuille test" reste neutre et ne donne que des infos.
Peux-tu y regarder,et corriger si possible?🙄
Merci de ton assistance.
laplayast@+
ci-joint le fichier.