problème code VBA

[Marion]

Bonsoir au forum

voici un code qui me permet de copier cetraines cellules dans un tableau, mon problème est qu'il marrive de copier deux fois ses valeurs.

en colonne B ce sont des dates
peut on interdire la copie si la date existe déjà ou avoir la possibilite de la remplacer

Dim res As String
Dim FinTablo As Integer
Application.ScreenUpdating = False

res = MsgBox('pour valider l'occupation des lignes et imprimer appuyer sur oui, pour imprimer uniquement appuyer sur non, pour sortir appuyer sur annuler', vbYesNoCancel)
If res = vbYes Then
FinTablo = Range('a6000').End(xlUp).Row
Range('A' & FinTablo + 1) = Range('A2').Value
Range('b' & FinTablo + 1) = Range('b2').Value
Range('c' & FinTablo + 1) = Range('c2').Value
Range('d' & FinTablo + 1) = Range('d2').Value
Range('e' & FinTablo + 1) = Range('e2').Value
Range('f' & FinTablo + 1) = Range('f2').Value
Range('G' & FinTablo + 1) = Range('G2').Value


Merci une nouvelle fois de votre aide

A+Marion

 

[ZZR09]

Bonjour Marion,

Si tu ne veux pas remplacer une cellule existante, teste la valeur de son contenu et compare la à la variable que tu veux copier

Peux-tu nous adresser une copie de ce qui te pose problème?
zippé et sans accents
C'est plus parlant pour ceux qui se panchent sur ton problème :huh:
A+

 

[Marion]

Bonsoir au forum.

merci ZZR09 pour m'avoir répondu

je joins un fichier vous comprendrez suremnt mieux.

Cette feuille me permet d' archiver des heures suivant une date

mon problème est que je rentre parfois deux fois la date ce qui me pose des soucis.

je voudrais, il ne manque pas grand chose dans le code existant que si la date est déjà dans la liste le message me propose si je veux la remplacer oui ou non

si oui alors je remplace la date dans le tableau si non exit sub


Merci de votre aide

A+Marion [file name=Marion15_20050715222739.zip size=46400]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Marion15_20050715222739.zip[/file]

 

[Robert]

Bonsoir Marion, ZZR, bonsoir le forum,

Marion j'ai modifié le code de ta macro et je pense que tu n'auras plus besoin du code sur l'événement Change de la feuille DECLARATION DES HEURES :

Option Explicit

Sub IMPRIMER_HEURES()
Dim res As String 'déclare la variable res
Dim a As String 'déclare la variable a
Dim F As Integer 'déclare la variable F
Dim D As Date 'déclare la variable D
Dim Cel As Range 'déclare la variable cel

Application.ScreenUpdating = False

D = DateValue(Range('B1').Value) 'définit la variable D (Date en B1)
F = Range('A65536').End(xlUp).Row 'définit la variable F (Fin du tableau)

'vérifie si la date existe déjà
For Each Cel In Range('B27:B' & F) 'boucle sur toutes les cellules de la plage B27:B_F
If DateValue(Cel) = D Then 'condition 1 : si la date de la cellule est égale à la date D de B1
'définit la variable a (message oui / non)
a = MsgBox('Cette date existe déjà. Voulez-vous la remplacer ?', vbYesNo, 'Attention !')
If a = vbYes Then 'condition 2 : si a = oui (remplacer la date)
Range('B1').Select 'sélectionne B1
Selection.ClearContents 'efface le contenu de B1
Exit Sub 'sort de la procédure
Else 'si a=non (ne pas remplacer)
Exit Sub 'sort de la procédure
End If 'fin de la condition 2
End If 'fin de la condition 1
Next Cel 'prochaine cellule de la plage


res = MsgBox('pour valider l'occupation des lignes et imprimer appuyer sur oui, pour imprimer uniquement appuyer sur non, pour sortir appuyer sur annuler', vbYesNoCancel)
If res = vbYes Then
Range('A' & F + 1) = Range('A2').Value
Range('B' & F + 1) = Range('B2').Value
Range('C' & F + 1) = Range('C2').Value
Range('D' & F + 1) = Range('D2').Value
Range('E' & F + 1) = Range('E2').Value
Range('F' & F + 1) = Range('F2').Value
Range('G' & F + 1) = Range('G2').Value

'ActiveSheet.PageSetup.BlackAndWhite = True
' Range('A1:K23').Select
'ActiveSheet.PageSetup.PrintArea = '$A$1:$K$23'
' ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
' ActiveSheet.PageSetup.BlackAndWhite = False
' Range('b5').Select
' ElseIf res = vbNo Then

' ActiveSheet.PageSetup.BlackAndWhite = True
' Range('A1:K23').Select
'ActiveSheet.PageSetup.PrintArea = '$A$1:$K$23'
'ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
'ActiveSheet.PageSetup.BlackAndWhite = False

Range('b5').Select
ElseIf res = vbCancel Then Exit Sub
End If
End Sub

 

[Marion]

RE bonsoir au forum

Bonsoir Robert et merci beaucoup, très bien les explications c'est beaucoup plus facile a comprendre .

j'ai mis le code dans mon fichier un petit truc il me demande si je veux remplacer la date si je répond oui il ne le fait pas


il doit y avoir un petit truc quelque par


Merci de ton aide

Gros bisous et bonne nuit


A+Marion

 

[Robert]

Bonsoir le fil, bonsoir le forum,

Ben non ! Marion. Je ne sais pas par quoi tu veux la remplacer alors dans l'état actuel du code, B1 est sélectionné et effacé pour que tu puisses retaper une nouvelle date. Explique-moi mieux pour que j'adapte le code si possible.

 

[Marion]

Bonjour le forum

Bonjour Robert et merci une nouvelle fois

je suis un peu compliquée tu va voir (Ha les femmes, je ne te dit pas)

je ne veux pas effacer la cellule b1 mais la ligne ou la date est déja positionner

il recherche, si la date y est: msgbox veux tu la remplacer

si oui il efface dans le tableaux la date existante et recopie les cellule de la ligne 2 pour les repositionner a la palce de la ligne éffacée

si non il continue sa procèdure sans faire de copie

si la date n'exite pas procedure normal sans msgbox.

Mais si cela est trop compliqué laisse tomber je pense pouvoir me débrouiller avec le code qui tu m'a amélioré

Merci de ton aide

A+Marion

 

[Robert]

Bonjour Marion, bonjour le forum,

Ok, alors voilà le code (je ne mets que la partie qui interresse, tu l'insèreras au bon endroit). Au lieu de sélectionner B1 et de l'effacer, ça redéfinit la variable F : F = Cel.Row -1. Du coup la partie du code qui place les donnés en fin de tableau : Range('A' & F + 1) = Range('A2').Value, etc... Va maintenant les placer par dessus la ligne contenant la date :

'vérifie si la date existe déjà
For Each Cel In Range('B27:B' & F) 'boucle sur toutes les cellules de la plage B27:B_F
If DateValue(Cel) = D Then 'condition 1 : si la date de la cellule est égale à la date D de B1
'définit la variable a (message oui / non)
a = MsgBox('Cette date existe déjà. Voulez-vous la remplacer ?', vbYesNo, 'Attention !')
If a = vbYes Then 'condition 2 : si a = oui (remplacer la date)
F = Cel.Row - 1 'définit la variable F la ligne de la cellule -1
Exit For 'sort de la boucle
Else 'si a=non (ne pas remplacer)
Exit Sub 'sort de la procédure
End If 'fin de la condition 2
End If 'fin de la condition 1
Next Cel 'prochaine cellule de la plage

 

[Marion]

RE bonjour au forum

Bonjour Robert

C'est exactement ce qu'il me fallait

Gros bisous et merci a toi bon Week end

A+Marion