Modifier macro enregistrement
bonjour a tous
je joins mon fichier
La macro valider_nouvelle_donnée que j'utilise fonctionne très bien jusqu'à la cellule désignation
mais je voudrais allez jusqu'à la cellule commentaire pour enregistrer et la galère
si quelqu'un a une idée je suis preneur
merci par avance
aiglon74
Bonjour,
Un essai ...
Sub valider_nouvelle_donnée()
'aiglon74
Dim nd(7), I%, fin& ''' << Nd(7) au lieu de 4 pour ajouter les 3 nouveaux éléments
With ActiveSheet
For I = 0 To 7 ''' << 7 au lieu de 4 pour ajouter les 3 nouveaux éléments
nd(I) = .Cells(8, (I + 1) * 2).Value
If nd(I) = "" And I < 7 Then ''' << 7 au lieu de 4 pour ajouter les 3 nouveaux éléments
MsgBox .Cells(6, (I + 1) * 2).Value & " manquante.", vbInformation, "Erreur nouvelle donnée"
Exit Sub
End If
Next I
End With
Dim trouve As Range
If Application.CountIf(Worksheets("BASE").Columns("B"), nd(0)) > 0 Then ' L'emplacemt existe dans la feuille "BASE"
Set trouve = Feuil7.Range("b:b").Find("LIBRE", lookat:=xlWhole)
If Not trouve Is Nothing Then
If MsgBox("Cet emplacement existe déjà !" & Chr(10) & " l'emplacement " & trouve.Offset(0, -1) & _
" est disponible" & vbCr & vbCr & "Voulez vous garder l'emplacement " & UCase(nd(0)), _
vbCritical + vbYesNo, "Erreur d'emplacement") <> vbYes Then Exit Sub
End If
End If
Application.ScreenUpdating = False
With Worksheets("BASE")
.Rows(7).Insert
.Cells(8, 6).Copy
.Cells(7, 6).PasteSpecial xlPasteFormulas
For I = 0 To 3
.Cells(7, I + 2).Value = nd(I)
Next I
.Cells(7, 7).Value = nd(4)
.Cells(7, 8).Value = nd(5) ''' << ajout de la colonne H
.Cells(7, 11).Value = nd(6) ''' << ajout de la colonne K
.Cells(7, 12).Value = nd(7) ''' << ajout de la colonne L
With .Range("B7:L7")
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
End With
For I = 7 To 10
With .Borders(I)
.LineStyle = xlContinuous
.Weight = xlMedium
End With
Next I
End With
fin = .Range("B" & .Rows.Count).End(xlUp).Row
.Range("B7:L" & fin).Sort key1:=.Range("B7"), order1:=xlAscending, Header:=xlNo
MsgBox ("ENREGISTREMENT REUSSI."), vbExclamation, "Enregistrement nouvelle donnée"
End With
Application.ScreenUpdating = True
Worksheets("nouvelle ref").Range("B8,D8,F8,H8,J8,L8,N8,P8").ClearContents
Application.ScreenUpdating = False
Sheets("nouvelle ref").Select
ActiveSheet.Unprotect
Range("Q8").Select
Selection.Locked = False
Selection.FormulaHidden = False
Sheets("nouvelle ref").Select
Worksheets("nouvelle ref").Range("Q8").ClearContents
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("nouvelle ref").Select
ActiveSheet.Unprotect
Selection.Locked = True
Selection.FormulaHidden = False
Sheets("nouvelle ref").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Range("B8").Select
End Sub
ric
Bonsoir ric
génial au top
si j'ose une explication en face des lignes possible
mais sincèrement merci
Bonjour,
Modifs sur seulement 3 lignes ...
Ajouts de 3 nouvelles lignes ...
Voir code précédent ...
ric
re
merci pour ta réponse
aiglon74