Bonjour à tous.
Je tiens déjà à remercier tous le monde pour toutes ces années à piocher dans les solutions données par tous les spécialistes !
Aujourd'hui c'est à mon tour de présenter mon problème.
Dans une macro évènementielle, il y a une ligne (noté en '!!!!!!!!!!!!!!!!!!!!cette ligne!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!) qui provoque une erreur 1004.
J'ai déjà tenter de la changer par un cells(a,b).select, ou activecell.find("***").select, mais rien à faire.
Je ne me heurte pas souvent à un problème dans excel, surtout grâce au forum, mais là, je ne comprend pas pourquoi cela ne marche pas, je pense que cela doit venir du Target dans la première feuille.... J'ai beau cherché, je m'en remets à vous.
Avez vous une solution ?
Merci...
--------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
'On Error Resume Next
'Application.ScreenUpdating = False
If Intersect(Target, Range("G3:G101")) Is Nothing Then Exit Sub
Target.Select
i = ActiveCell.Row - 2
If Target.Offset(0, 2).Value <> "²" And Target.Value >= 1 And Target.Value <= 24 Then
'If ActiveCell.Value >= 1 And ActiveCell.Value <= 24 Then
Sheets("Schémas COUPE").Select
ActiveSheet.Shapes("refimage").Copy
Sheets("Débit horizontal").Select
ActiveCell.Offset(0, 1).Select
ActiveSheet.Paste
ActiveSheet.Pictures("refimage").Name = "Image" & i
p = i + 2
ActiveWorkbook.Names.Add Name:="AdrPhoto" & i, RefersToR1C1:="=OFFSET('schémas COUPE'!R2C2,MATCH('débit horizontal'!R" & p & "C7,OFFSET('schémas COUPE'!R2C1,,,COUNTA('schémas COUPE'!C1)-1),0)-1,0)"
Selection.Formula = "=AdrPhoto" & i
ActiveCell.Offset(0, 2).Select
Target.Offset(0, 2).Value = "²"
Sheets("Schémas COUPE").Select
ActiveSheet.Shapes("refimage2").Copy
Sheets("Débit").Select
Range("R9").select '!!!!!!!!!!!!!!!!!!!!cette ligne!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
r = 9
f = 18 + i
Cells(r, f).Select
ActiveSheet.Paste
ActiveSheet.Pictures("refimage2").Name = "Image" & i
Else
If Target.Value = "" Then
ActiveSheet.Shapes("Image" & i).Delete
ActiveWorkbook.Names("AdrPhoto" & i).Delete
Target.Offset(0, 2).Value = ""
'Target.Value = "0"
'Target.Select
Exit Sub
End If
End If
'Application.ScreenUpdating = True
End Sub
Je tiens déjà à remercier tous le monde pour toutes ces années à piocher dans les solutions données par tous les spécialistes !
Aujourd'hui c'est à mon tour de présenter mon problème.
Dans une macro évènementielle, il y a une ligne (noté en '!!!!!!!!!!!!!!!!!!!!cette ligne!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!) qui provoque une erreur 1004.
J'ai déjà tenter de la changer par un cells(a,b).select, ou activecell.find("***").select, mais rien à faire.
Je ne me heurte pas souvent à un problème dans excel, surtout grâce au forum, mais là, je ne comprend pas pourquoi cela ne marche pas, je pense que cela doit venir du Target dans la première feuille.... J'ai beau cherché, je m'en remets à vous.
Avez vous une solution ?
Merci...
--------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
'On Error Resume Next
'Application.ScreenUpdating = False
If Intersect(Target, Range("G3:G101")) Is Nothing Then Exit Sub
Target.Select
i = ActiveCell.Row - 2
If Target.Offset(0, 2).Value <> "²" And Target.Value >= 1 And Target.Value <= 24 Then
'If ActiveCell.Value >= 1 And ActiveCell.Value <= 24 Then
Sheets("Schémas COUPE").Select
ActiveSheet.Shapes("refimage").Copy
Sheets("Débit horizontal").Select
ActiveCell.Offset(0, 1).Select
ActiveSheet.Paste
ActiveSheet.Pictures("refimage").Name = "Image" & i
p = i + 2
ActiveWorkbook.Names.Add Name:="AdrPhoto" & i, RefersToR1C1:="=OFFSET('schémas COUPE'!R2C2,MATCH('débit horizontal'!R" & p & "C7,OFFSET('schémas COUPE'!R2C1,,,COUNTA('schémas COUPE'!C1)-1),0)-1,0)"
Selection.Formula = "=AdrPhoto" & i
ActiveCell.Offset(0, 2).Select
Target.Offset(0, 2).Value = "²"
Sheets("Schémas COUPE").Select
ActiveSheet.Shapes("refimage2").Copy
Sheets("Débit").Select
Range("R9").select '!!!!!!!!!!!!!!!!!!!!cette ligne!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
r = 9
f = 18 + i
Cells(r, f).Select
ActiveSheet.Paste
ActiveSheet.Pictures("refimage2").Name = "Image" & i
Else
If Target.Value = "" Then
ActiveSheet.Shapes("Image" & i).Delete
ActiveWorkbook.Names("AdrPhoto" & i).Delete
Target.Offset(0, 2).Value = ""
'Target.Value = "0"
'Target.Select
Exit Sub
End If
End If
'Application.ScreenUpdating = True
End Sub
