Bonjour,
J’espère que quelqu’un sera en mesure de m'aider.
J'ai créé une macro qui me permet de copier coller une image a un ou plusieurs endroit en même temps lorsque j'appuie sur un bouton contrôle de formulaire.
Tout fonctionnais bien jusqu’à présent cependant maintenant si je sélectionne deux emplacement pour la meme image cela me fait planter exel.
Quelq'un peut il m'aider s'il vous plait ?
Merci d'avance,
Cordialement,
Sub signature_freuze()
'
' signature_freuze Macro
'
'
Dim mdp As String
Dim key As String
key = "0000"
mdp = InputBox("Entrez le mot de passe")
If mdp = key Then
If Range("G5") = "FREUZE" Then
Range("H5:H6").Select
Sheets("Data").Select
ActiveSheet.Shapes.Range(Array("Image 15")).Select
Selection.Copy
Sheets("mensuel CP").Select
ActiveSheet.Paste
Selection.ShapeRange.ScaleWidth 1.3757946698, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 1.512295658, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.IncrementLeft 7.5
Selection.ShapeRange.IncrementTop 3.2143307087
End If
If Range("I5") = "FREUZE" Then
Range("J5:J6").Select
Sheets("Data").Select
ActiveSheet.Shapes.Range(Array("Image 15")).Select
Selection.Copy
Sheets("mensuel CP").Select
ActiveSheet.Paste
Selection.ShapeRange.ScaleWidth 1.1684838462, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 1.5567744614, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.IncrementLeft 9.6428346457
Selection.ShapeRange.IncrementTop 2.1429133858
End If
If Range("I10") = "FREUZE" Then
Range("I11:J11").Select
Sheets("Data").Select
ActiveSheet.Shapes.Range(Array("Image 15")).Select
Selection.Copy
Sheets("mensuel CP").Select
ActiveSheet.Paste
Selection.ShapeRange.ScaleWidth 1.5265679406, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 1.2009374969, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.IncrementLeft 43.9285826772
Selection.ShapeRange.IncrementTop 1.071496063
End If
Else: MsgBox "Mot de passe erroné Accès refusé"
End If
End Sub
J’espère que quelqu’un sera en mesure de m'aider.
J'ai créé une macro qui me permet de copier coller une image a un ou plusieurs endroit en même temps lorsque j'appuie sur un bouton contrôle de formulaire.
Tout fonctionnais bien jusqu’à présent cependant maintenant si je sélectionne deux emplacement pour la meme image cela me fait planter exel.
Quelq'un peut il m'aider s'il vous plait ?
Merci d'avance,
Cordialement,
Sub signature_freuze()
'
' signature_freuze Macro
'
'
Dim mdp As String
Dim key As String
key = "0000"
mdp = InputBox("Entrez le mot de passe")
If mdp = key Then
If Range("G5") = "FREUZE" Then
Range("H5:H6").Select
Sheets("Data").Select
ActiveSheet.Shapes.Range(Array("Image 15")).Select
Selection.Copy
Sheets("mensuel CP").Select
ActiveSheet.Paste
Selection.ShapeRange.ScaleWidth 1.3757946698, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 1.512295658, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.IncrementLeft 7.5
Selection.ShapeRange.IncrementTop 3.2143307087
End If
If Range("I5") = "FREUZE" Then
Range("J5:J6").Select
Sheets("Data").Select
ActiveSheet.Shapes.Range(Array("Image 15")).Select
Selection.Copy
Sheets("mensuel CP").Select
ActiveSheet.Paste
Selection.ShapeRange.ScaleWidth 1.1684838462, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 1.5567744614, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.IncrementLeft 9.6428346457
Selection.ShapeRange.IncrementTop 2.1429133858
End If
If Range("I10") = "FREUZE" Then
Range("I11:J11").Select
Sheets("Data").Select
ActiveSheet.Shapes.Range(Array("Image 15")).Select
Selection.Copy
Sheets("mensuel CP").Select
ActiveSheet.Paste
Selection.ShapeRange.ScaleWidth 1.5265679406, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 1.2009374969, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.IncrementLeft 43.9285826772
Selection.ShapeRange.IncrementTop 1.071496063
End If
Else: MsgBox "Mot de passe erroné Accès refusé"
End If
End Sub