Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Automatisation incomplète

Automatisation incomplète

3 réponses
Avatar
Fredo P.
(office XP). Avec ses deux proc tout fonctionne, mais j'ai essayé à la place
de
MsgBox "En A1, indiquez la date de naissance du lot "format: jj/mm/aa"
d'employer [A1]=inputbox" indiquez la date de naissance du lot "
Malheureusement cela ne veux pas passer, >Envois du rapport d'erreur chez
Msf> récupération>fermeture>ouverture de l'ancien enregistrement. À noter
aussi, j'ai fait un essai sans le code Workbook_SheetChange avec la même fin
de non-recevoir.
Si Qq à une idée?

Sub AjoutdeFeuille()
On Error GoTo gesterr
Dim wb As Workbook, Code$
Dim Nm$
enaF ' EnableEvents = False
Feuil1.Select
Range("A1:AF39").Select
Selection.Copy
Sheets.Add
ActiveSheet.Paste
Range("A1,A5:B39,C2:AD39").ClearContents
[A1].Select
Set wb = ActiveWorkbook
Nm = ActiveSheet.CodeName
Code = "Private Sub Worksheet_Change(ByVal Target As Range)" & vbLf
Code = Code & "Compte Target " & vbLf
Code = Code & "End Sub"
wb.VBProject.VBComponents(Nm).CodeModule.AddFromString Code
gesterr:
If Err > 0 Then
MsgBox ("Erreur " & Err)
Err.Clear
End If
Set wb = Nothing
enaT 'EnableEvents = True
MsgBox "En A1, indiquez la date de naissance du lot "format: jj/mm/aa"
End Sub
§§§§§§§

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
If Not Intersect([A1], Target) Is Nothing And IsDate([A1]) Then
If IsError(ActiveWorkbook.Worksheets("Lot " & Right(100 + Day([A1]), 2) &
"_" & Right(100 + Month([A1]), 2))) Then
If Err > 0 Then
ActiveSheet.Name = "Lot " & Right(100 + Day([A1]), 2) & "_" & Right(100 +
Month([A1]), 2)
End If
End If
End If
End Sub

--
Fredo P.
Signaler un problème avec ce contenu

3 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Daniel.C
Bonjour.
Essaie :
[A1] = CDate(InputBox(" indiquez la date de naissance du lot "))
Cordialement.
Daniel

(office XP). Avec ses deux proc tout fonctionne, mais j'ai essayé à la place
de
MsgBox "En A1, indiquez la date de naissance du lot "format: jj/mm/aa"
d'employer [A1]=inputbox" indiquez la date de naissance du lot "
Malheureusement cela ne veux pas passer, >Envois du rapport d'erreur chez
Msf> récupération>fermeture>ouverture de l'ancien enregistrement. À noter
aussi, j'ai fait un essai sans le code Workbook_SheetChange avec la même fin
de non-recevoir.
Si Qq à une idée?

Sub AjoutdeFeuille()
On Error GoTo gesterr
Dim wb As Workbook, Code$
Dim Nm$
enaF ' EnableEvents = False
Feuil1.Select
Range("A1:AF39").Select
Selection.Copy
Sheets.Add
ActiveSheet.Paste
Range("A1,A5:B39,C2:AD39").ClearContents
[A1].Select
Set wb = ActiveWorkbook
Nm = ActiveSheet.CodeName
Code = "Private Sub Worksheet_Change(ByVal Target As Range)" & vbLf
Code = Code & "Compte Target " & vbLf
Code = Code & "End Sub"
wb.VBProject.VBComponents(Nm).CodeModule.AddFromString Code
gesterr:
If Err > 0 Then
MsgBox ("Erreur " & Err)
Err.Clear
End If
Set wb = Nothing
enaT 'EnableEvents = True
MsgBox "En A1, indiquez la date de naissance du lot "format: jj/mm/aa"
End Sub
§§§§§§§

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
If Not Intersect([A1], Target) Is Nothing And IsDate([A1]) Then
If IsError(ActiveWorkbook.Worksheets("Lot " & Right(100 + Day([A1]), 2) &
"_" & Right(100 + Month([A1]), 2))) Then
If Err > 0 Then
ActiveSheet.Name = "Lot " & Right(100 + Day([A1]), 2) & "_" & Right(100 +
Month([A1]), 2)
End If
End If
End If
End Sub


Avatar
Fredo P.
"Daniel.C" a écrit dans le message de
news:
Bonjour.
Essaie :
[A1] = CDate(InputBox(" indiquez la date de naissance du lot "))
Cordialement.
Daniel



Merci Daniel de t"intéresser à ce pb, ce que tu me proposes ne l'a
malheureusement pas résolu.
--
Fredo P.

> (office XP). Avec ses deux proc tout fonctionne, mais j'ai essayé à la


place
> de
> MsgBox "En A1, indiquez la date de naissance du lot "format: jj/mm/aa"
> d'employer [A1]=inputbox" indiquez la date de naissance du lot "
> Malheureusement cela ne veux pas passer, >Envois du rapport d'erreur


chez
> Msf> récupération>fermeture>ouverture de l'ancien enregistrement. À


noter
> aussi, j'ai fait un essai sans le code Workbook_SheetChange avec la même


fin
> de non-recevoir.
> Si Qq à une idée?
>
> Sub AjoutdeFeuille()
> On Error GoTo gesterr
> Dim wb As Workbook, Code$
> Dim Nm$
> enaF ' EnableEvents = False
> Feuil1.Select
> Range("A1:AF39").Select
> Selection.Copy
> Sheets.Add
> ActiveSheet.Paste
> Range("A1,A5:B39,C2:AD39").ClearContents
> [A1].Select
> Set wb = ActiveWorkbook
> Nm = ActiveSheet.CodeName
> Code = "Private Sub Worksheet_Change(ByVal Target As Range)" & vbLf
> Code = Code & "Compte Target " & vbLf
> Code = Code & "End Sub"
> wb.VBProject.VBComponents(Nm).CodeModule.AddFromString Code
> gesterr:
> If Err > 0 Then
> MsgBox ("Erreur " & Err)
> Err.Clear
> End If
> Set wb = Nothing
> enaT 'EnableEvents = True
> MsgBox "En A1, indiquez la date de naissance du lot "format:


jj/mm/aa"
> End Sub
> §§§§§§§
>
> Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As


Range)
> On Error Resume Next
> If Not Intersect([A1], Target) Is Nothing And IsDate([A1]) Then
> If IsError(ActiveWorkbook.Worksheets("Lot " & Right(100 + Day([A1]), 2)


&
> "_" & Right(100 + Month([A1]), 2))) Then
> If Err > 0 Then
> ActiveSheet.Name = "Lot " & Right(100 + Day([A1]), 2) & "_" & Right(100


+
> Month([A1]), 2)
> End If
> End If
> End If
> End Sub




Avatar
Daniel.C
Bonjour.
L'erreur est toujours la même ?
En décomposant, pour voir où ça twiste :
Rep = CDate(InputBox(" indiquez la date de naissance du lot "))
MsgBox Rep
Range("A1").value = Rep
Cordialement.
Daniel


"Daniel.C" a écrit dans le message de
news:
Bonjour.
Essaie :
[A1] = CDate(InputBox(" indiquez la date de naissance du lot "))
Cordialement.
Daniel



Merci Daniel de t"intéresser à ce pb, ce que tu me proposes ne l'a
malheureusement pas résolu.
--
Fredo P.

(office XP). Avec ses deux proc tout fonctionne, mais j'ai essayé à la
place de
MsgBox "En A1, indiquez la date de naissance du lot "format: jj/mm/aa"
d'employer [A1]=inputbox" indiquez la date de naissance du lot "
Malheureusement cela ne veux pas passer, >Envois du rapport d'erreur chez
Msf> récupération>fermeture>ouverture de l'ancien enregistrement. À noter
aussi, j'ai fait un essai sans le code Workbook_SheetChange avec la même
fin de non-recevoir.
Si Qq à une idée?

Sub AjoutdeFeuille()
On Error GoTo gesterr
Dim wb As Workbook, Code$
Dim Nm$
enaF ' EnableEvents = False
Feuil1.Select
Range("A1:AF39").Select
Selection.Copy
Sheets.Add
ActiveSheet.Paste
Range("A1,A5:B39,C2:AD39").ClearContents
[A1].Select
Set wb = ActiveWorkbook
Nm = ActiveSheet.CodeName
Code = "Private Sub Worksheet_Change(ByVal Target As Range)" & vbLf
Code = Code & "Compte Target " & vbLf
Code = Code & "End Sub"
wb.VBProject.VBComponents(Nm).CodeModule.AddFromString Code
gesterr:
If Err > 0 Then
MsgBox ("Erreur " & Err)
Err.Clear
End If
Set wb = Nothing
enaT 'EnableEvents = True
MsgBox "En A1, indiquez la date de naissance du lot "format: jj/mm/aa"
End Sub
§§§§§§§

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
If Not Intersect([A1], Target) Is Nothing And IsDate([A1]) Then
If IsError(ActiveWorkbook.Worksheets("Lot " & Right(100 + Day([A1]), 2) &
"_" & Right(100 + Month([A1]), 2))) Then
If Err > 0 Then
ActiveSheet.Name = "Lot " & Right(100 + Day([A1]), 2) & "_" & Right(100 +
Month([A1]), 2)
End If
End If
End If
End Sub