recopie feuille

Le
Peponne31
Bonjour,

Dans un classeur, j'ai 2 feuilles du nom de: Devis1page, Devis2pages.
Je voudrais quand Devis1page en J3
si je rentre un N° de feuille qui correspondrai
à Devis2pages j'ai un message d'erreur.
J'ai écrit cela mais ça ne fonctionne pas.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Dim vNom As String
vNom = ("Devis1page")
If Target.Address = "$J$6" Then
ValideSaisie
LectureDeJ6
ActiveSheet.Unprotect
EcritureDeB10
ActiveSheet.Protect
ElseIf Target.Address = "$J$3" Then
RéouvreDevis1page Target.Value
If vNom = ("Devis2pages") Then
Message = MsgBox("ERREUR, c'est un Devis 2 Pages", ,
"FERRE Jean-Raymond")
ActiveSheet.Unprotect
Range("B10,B11,J3").Select
Selection.ClearContents
ActiveSheet.Protect
Range("J3").Select
Range("J3").Activate
Else
MaValeurDeB10
MaValeurDeJ6
ActiveSheet.Protect
End If
End If
End Sub
Si quelqu'un veut bien m'aider à corriger !!
Merci par avance.
Peponne31
Vos réponses Page 2 / 2
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Peponne31
Le #20086751
Bonjour Hervé,

Je viens de mètre en application ta solution,
et j'ai une erreur d' exécution 1004

C:_FERRE Jean-REaymonddevis.xls introuvable

le répertoire na pas changé d' emplacement,
je présume qu'il ne prend pas en compte le N° du devis en J3
j'ai ceci en surbrillance:

Set Cl = Workbooks.Open(Chemin & Fich & ".xls")

je te remerci pour le temps que tu me consacre

Peponne31

"Hervé" a écrit :

Bonsoir,

Teste ceci (pas testé !) :

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Cl As Workbook
Dim Fe As Worksheet
Dim Chemin As String

Chemin = "C:FERRE Jean-Raymonddevis"

Application.ScreenUpdating = False

If Target.Address = "$J$6" Then

ValideSaisie
LectureDeJ6
ActiveSheet.Unprotect
EcritureDeB10
ActiveSheet.Protect

ElseIf Target.Address = "$J$3" Then

If Dir(Chemin & Target.Value & ".xls") = "" Then

zz_Clignote2
Message = MsgBox("Ce N° de devis n'existe pas !", , "FERRE
Jean-Raymond")
Range("B10,B11,J3").ClearContents
Range("J3").Select
Range("J3").Activate

Else

Set Cl = Workbooks.Open(Chemin & Fich & ".xls")
'ici peut être indiqué le nom de la feuille pour
'plus de clarté : Set Fe = Cl.Worksheets("Feuil1")
Set Fe = Cl.ActiveSheet
'si la feuille contient un saut de page
'c'est une feuille à 2 pages à l'impression
If Fe.HPageBreaks.Count >= 1 Then

Message = MsgBox("ERREUR, c'est un Devis 2 Pages", _
, _
"FERRE Jean-Raymond")
ActiveSheet.Unprotect
Range("B10,B11,J3").Select
Selection.ClearContents
ActiveSheet.Protect
Range("J3").Select
Range("J3").Activate

Else

ActiveSheet.Unprotect '???
Range("I12").FormulaR1C1 = "=TODAY()"
Range("date").Select
RéouvreDevis1page Fe
MaValeurDeB10
MaValeurDeJ6
ActiveSheet.Protect
Cl.Close False

End If

End If

'ici, la proc "RéouvreDevis1page" devrait
'retourner un objet feuille
RéouvreDevis1page Target.Value, SautDePage

End If

Application.ScreenUpdating = True

Set Fe = Nothing
Set Cl = Nothing

End Sub

Sub RéouvreDevis1page(Fe As Worksheet)

Dim Ctr As Integer
Dim Plage As Range
Dim c As Range


'Transforme aujourdhui () en valeur

Ctr = 21

With Workbooks("FERRE Jean-Raymond.xls").Sheets("Devis1page")
.Range("num_client") = Fe.Range("num_client")
.Range("dnomcli1") = Fe.Range("dnomcli1")
.Range("numdevis1") = Fe.Range("numdevis1")
.Range("frue1") = Fe.Range("frue1")
.Range("frue2") = Fe.Range("frue2")
.Range("fville") = Fe.Range("fville")
.Range("fcp") = Fe.Range("fcp")
.Range("téléphone") = Fe.Range("téléphone")
.Range("portable") = Fe.Range("portable")
.Range("fremise") = Fe.Range("dremise")
.Range("B17") = Fe.Range("B17")
.Range("H4") = Fe.Range("H4")
.Range("H5") = Fe.Range("H5")
.Range("I51") = Fe.Range("I51")
Set Plage = Fe.Range("A21:A50")

For Each c In Plage

.Range("A" & Ctr) = c.Value
.Range("F" & Ctr) = c.Offset(0, 1)
.Range("G" & Ctr) = c.Offset(0, 2)
.Range("H" & Ctr) = c.Offset(0, 3)
.Range("J" & Ctr) = c.Offset(0, 5)
Ctr = Ctr + 1

Next c

End With

End Sub

Hervé.


"Peponne31" news:
> PS:
>
> Mes feuilles ont pour nom d'onglet Devis1page et Devis2pages.
> Si ça peut faciliter pour la recopie !!
> Merci à toi
> Peponne31
>
>
> "Hervé" a écrit :
>
>> Bonjour Peponne31,
>>
>> C'est normal, comme je te l'ai dit dans mon exemple, la proc
>> "RéouvreDevis1page(Target.Value)" devrait retourner un objet feuille
>> (c'est
>> juste une idée) ne connaissant pas cette procédure j'ai fait cette
>> supposition. Montre nous cette procédure pour voir les modifications à
>> apporter soit à mon code soit à la procédure.
>>
>> Hervé.
>>
>>
>> "Peponne31" >> de
>> news:
>> > Bonjour Hervé,
>> >
>> > Merci pour ton aide, j'ai encore un souci au niveau de:
>> > Set Fe = RéouvreDevis1page(Target.Value)
>> > Erreur de compilation:
>> > Fonction ou variable attendue
>> > Merci encore pour ton aide
>> >
>> > Peponne31
>> >
>> > "Hervé" a écrit :
>> >
>> >>
>> >> Bonsoir Peponne31,
>> >>
>> >> Je pense avoir compris ce que tu désire réaliser.
>> >> Pour savoir si le devis que tu souhaite ouvrir se trouve sur une ou
>> >> deux
>> >> pages (à l'impression bien sûr !) il suffit de connaître le nombre de
>> >> saut
>> >> de pages, si il est égal à zéro, c'est un devis sur une page, dans le
>> >> cas
>> >> contraire, c'est un devis sur deux pages (ou plus si tu le désire, il
>> >> suffit
>> >> d'adapter).
>> >> J'ai un peu modifié ta procédure. En admettant que la valeur est
>> >> changée
>> >> dans J3, la proc "RéouvreDevis1page(Target.Value)" devrait retourner
>> >> un
>> >> objet feuille (je pense que le nom de la feuille est la valeur en J3
>> >> ?)
>> >> ensuite, un contrôle est fait sur le nombre de sauts de pages
>> >> horizontaux,
>> >> si il y à au moins un saut de page, le devis est sur deux pages et ton
>> >> message d'erreur sera affiché. Adapte au mieux et revient si tu a
>> >> d'autres
>> >> soucis.
>> >>
>> >> Private Sub Worksheet_Change(ByVal Target As Range)
>> >>
>> >> Dim vNom As String
>> >> Dim Fe As Worksheet
>> >>
>> >> Application.ScreenUpdating = False
>> >>
>> >> vNom = ("Devis1page")
>> >>
>> >> If Target.Address = "$J$6" Then
>> >>
>> >> ValideSaisie
>> >> LectureDeJ6
>> >> ActiveSheet.Unprotect
>> >> EcritureDeB10
>> >> ActiveSheet.Protect
>> >>
>> >> ElseIf Target.Address = "$J$3" Then
>> >>
>> >> 'ici, la proc "RéouvreDevis1page" devrait
>> >> 'retourner un objet feuille
>> >> Set Fe = RéouvreDevis1page(Target.Value)
>> >>
>> >> 'si la feuille contient un saut de page
>> >> 'c'est une feuille à 2 pages à l'impression
>> >> If Fe.HPageBreaks.Count >= 1 Then
>> >>
>> >> Message = MsgBox("ERREUR, c'est un Devis 2 Pages", _
>> >> , _
>> >> "FERRE Jean-Raymond")
>> >> ActiveSheet.Unprotect
>> >> Range("B10,B11,J3").Select
>> >> Selection.ClearContents
>> >> ActiveSheet.Protect
>> >> Range("J3").Select
>> >> Range("J3").Activate
>> >>
>> >> Else
>> >>
>> >> MaValeurDeB10
>> >> MaValeurDeJ6
>> >> ActiveSheet.Protect
>> >>
>> >> End If
>> >> End If
>> >>
>> >> Application.ScreenUpdating = True
>> >>
>> >> Set Fe = Nothing
>> >>
>> >> End Sub
>> >>
>> >> 'exemple de fonction (très simple) que retourne une feuille
>> >> Function RéouvreDevis1page(C As String) As Worksheet
>> >>
>> >> Set RéouvreDevis1page = Worksheets(C)
>> >>
>> >> End Function
>> >>
>> >> Hervé.
>> >>
>> >>
>> >> "Peponne31" >> >> message
>> >> de
>> >> news:
>> >> > Bonsoir FS
>> >> >
>> >> > Merci pour ta réponse, mais ce n'est pas ce que je recherche
>> >> > les feuille Devis1page et Devis2pages sont des formulaires qui me
>> >> > servent
>> >> > à
>> >> > réaliser des devis en maçonnerie. Ces devis sont imprimé soit sur
>> >> > une
>> >> > feuille
>> >> > ou sur 2 feuilles papier tout dépand du travail à faire. C'est pour
>> >> > cela
>> >> > que
>> >> > dans le classeur j'ai une feuille nommée Devis1page et une autre
>> >> > Devis2pages
>> >> > .Si je veux modifier un devis je le rappelle par son N° en J3 et ça
>> >> > fonctionne, mais je ne sais pas faire la differance entre 1 feuille
>> >> > et
>> >> > 2
>> >> > feuilles, si je rappelle un devis sur 2 feuilles dans le formulaire
>> >> > Devis1page il y va avec des erreurs dans les cellules, c'est pour ça
>> >> > que
>> >> > je
>> >> > voudrais interdire la recopie d'un devis 2 pages sur sur le
>> >> > formulaire
>> >> > Devis1page et vice versa.
>> >> > Merci
>> >> >
>> >> > "FS" a écrit :
>> >> >
>> >> >> Bonsoir,
>> >> >>
>> >> >> Pour empêcher toute recopie (ou copie) une solution radicale :
>> >> >>
>> >> >> Private Sub Workbook_SheetSelectionChange( _
>> >> >> ByVal Sh As Object, ByVal Target As Range)
>> >> >> Application.CutCopyMode = False
>> >> >> End Sub
>> >> >>
>> >> >> A recopier dans le module ThisWorkbook du classeur qui t'intéresse.
>> >> >> Attention, ça empêche tout copier/coller (tant que les macros sont
>> >> >> activées).
>> >> >>


Publicité
Poster une réponse
Anonyme