Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Compteur en VBA image non copiée

Compteur en VBA image non copiée

6 réponses
Avatar
jpthillard
De retour pour un conseil.
Ce matin je demandais d=E9j=E0 de l'aide sur cette macro. Tout fonctionne
=E0 merveille sauf qu'une image incluse dans la plage B1:I53 de
sauvegarde n'est pas copi=E9e. Est-ce que quelqu'un peu m'aider sur le
coup l=E0?

Merci d'avance JP

Sub Sauvegarde()
ActiveSheet.Protect Password:=3D"JP", userinterfaceonly:=3DTrue
r=E9pertoire =3D ActiveWorkbook.Path
DemandeMateriaux =3D "DM" & Format([g2], " 0000")
Sheets("DM").Copy
[B1:I53].Copy
[B1:I53].PasteSpecial Paste:=3DxlPasteValues
For Each s In ActiveSheet.Shapes: s.Delete: Next s
[D2].Select
ActiveWorkbook.SaveAs Filename:=3Dr=E9pertoire & "\" & DemandeMateriaux
MsgBox DemandeMateriaux & " sauvegard=E9e"
ActiveWorkbook.Close
Sheets("DM").Select
[g2] =3D [g2] + 1
Range("B8:H48,D2,D3,D5,G3,G5,I5,D49").ClearContents
ActiveWorkbook.Save
End Sub
Signaler un problème avec ce contenu

6 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
JB
Bonjour,

Remplacer la boucle :

For Each s In ActiveSheet.Shapes: s.Delete: Next s

Par :

ActiveSheet.Shapes("xxx").Delete pour supprimer le bouton

JB


On 21 fév, 13:19, wrote:
De retour pour un conseil.
Ce matin je demandais déjà de l'aide sur cette macro. Tout fonctionne
à merveille sauf qu'une image incluse dans la plage B1:I53 de
sauvegarde n'est pas copiée. Est-ce que quelqu'un peu m'aider sur le
coup là?

Merci d'avance JP

Sub Sauvegarde()
ActiveSheet.Protect Password:="JP", userinterfaceonly:=True
répertoire = ActiveWorkbook.Path
DemandeMateriaux = "DM" & Format([g2], " 0000")
Sheets("DM").Copy
[B1:I53].Copy
[B1:I53].PasteSpecial Paste:=xlPasteValues
For Each s In ActiveSheet.Shapes: s.Delete: Next s
[D2].Select
ActiveWorkbook.SaveAs Filename:=répertoire & "" & DemandeMateriaux
MsgBox DemandeMateriaux & " sauvegardée"
ActiveWorkbook.Close
Sheets("DM").Select
[g2] = [g2] + 1
Range("B8:H48,D2,D3,D5,G3,G5,I5,D49").ClearContents
ActiveWorkbook.Save
End Sub


Avatar
jpthillard
On 21 fév, 14:15, "JB" wrote:
Bonjour,

Remplacer la boucle :

For Each s In ActiveSheet.Shapes: s.Delete: Next s

Par :

ActiveSheet.Shapes("xxx").Delete pour supprimer le bouton

JB

On 21 fév, 13:19, wrote:



De retour pour un conseil.
Ce matin je demandais déjà de l'aide sur cette macro. Tout fonction ne
à merveille sauf qu'une image incluse dans la plage B1:I53 de
sauvegarde n'est pas copiée. Est-ce que quelqu'un peu m'aider sur le
coup là?

Merci d'avance JP

Sub Sauvegarde()
ActiveSheet.Protect Password:="JP", userinterfaceonly:=True
répertoire = ActiveWorkbook.Path
DemandeMateriaux = "DM" & Format([g2], " 0000")
Sheets("DM").Copy
[B1:I53].Copy
[B1:I53].PasteSpecial Paste:=xlPasteValues
For Each s In ActiveSheet.Shapes: s.Delete: Next s
[D2].Select
ActiveWorkbook.SaveAs Filename:=répertoire & "" & DemandeMateria ux
MsgBox DemandeMateriaux & " sauvegardée"
ActiveWorkbook.Close
Sheets("DM").Select
[g2] = [g2] + 1
Range("B8:H48,D2,D3,D5,G3,G5,I5,D49").ClearContents
ActiveWorkbook.Save
End Sub- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -


JB, le bouton disparaît sans problème en revanche, c'est une image
en .jpg (logo de ma boite) qui disparaît à la suite de cette ligne la
de la macro
" [B1:I53].PasteSpecial Paste:=xlPasteValues"

A+ et encore merci
JP


Avatar
JB
Je suis surpris. Le collages spécial valeurs ne supprime pas les
images.
La boucle For Each s In ActiveSheet.Shapes: s.Delete: Next s a t-elle
bien été supprimée?

ActiveSheet.Shapes("xxx").Left00
ActiveSheet.Shapes("xxx").Top00

Permet de déplacer des Images.

JB

On 21 fév, 14:29, wrote:
On 21 fév, 14:15, "JB" wrote:





Bonjour,

Remplacer la boucle :

For Each s In ActiveSheet.Shapes: s.Delete: Next s

Par :

ActiveSheet.Shapes("xxx").Delete pour supprimer le bouton

JB

On 21 fév, 13:19, wrote:

De retour pour un conseil.
Ce matin je demandais déjà de l'aide sur cette macro. Tout foncti onne
à merveille sauf qu'une image incluse dans la plage B1:I53 de
sauvegarde n'est pas copiée. Est-ce que quelqu'un peu m'aider sur le
coup là?

Merci d'avance JP

Sub Sauvegarde()
ActiveSheet.Protect Password:="JP", userinterfaceonly:=True
répertoire = ActiveWorkbook.Path
DemandeMateriaux = "DM" & Format([g2], " 0000")
Sheets("DM").Copy
[B1:I53].Copy
[B1:I53].PasteSpecial Paste:=xlPasteValues
For Each s In ActiveSheet.Shapes: s.Delete: Next s
[D2].Select
ActiveWorkbook.SaveAs Filename:=répertoire & "" & DemandeMater iaux
MsgBox DemandeMateriaux & " sauvegardée"
ActiveWorkbook.Close
Sheets("DM").Select
[g2] = [g2] + 1
Range("B8:H48,D2,D3,D5,G3,G5,I5,D49").ClearContents
ActiveWorkbook.Save
End Sub- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -


JB, le bouton disparaît sans problème en revanche, c'est une image
en .jpg (logo de ma boite) qui disparaît à la suite de cette ligne la
de la macro
" [B1:I53].PasteSpecial Paste:=xlPasteValues"

A+ et encore merci
JP- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -




Avatar
jpthillard
On 21 fév, 15:04, "JB" wrote:
Je suis surpris. Le collages spécial valeurs ne supprime pas les
images.
La boucle For Each s In ActiveSheet.Shapes: s.Delete: Next s a t-elle
bien été supprimée?

ActiveSheet.Shapes("xxx").Left00
ActiveSheet.Shapes("xxx").Top00

Permet de déplacer des Images.

JB

On 21 fév, 14:29, wrote:



On 21 fév, 14:15, "JB" wrote:

Bonjour,

Remplacer la boucle :

For Each s In ActiveSheet.Shapes: s.Delete: Next s

Par :

ActiveSheet.Shapes("xxx").Delete pour supprimer le bouton

JB

On 21 fév, 13:19, wrote:

De retour pour un conseil.
Ce matin je demandais déjà de l'aide sur cette macro. Tout fonc tionne
à merveille sauf qu'une image incluse dans la plage B1:I53 de
sauvegarde n'est pas copiée. Est-ce que quelqu'un peu m'aider sur le
coup là?

Merci d'avance JP

Sub Sauvegarde()
ActiveSheet.Protect Password:="JP", userinterfaceonly:=True
répertoire = ActiveWorkbook.Path
DemandeMateriaux = "DM" & Format([g2], " 0000")
Sheets("DM").Copy
[B1:I53].Copy
[B1:I53].PasteSpecial Paste:=xlPasteValues
For Each s In ActiveSheet.Shapes: s.Delete: Next s
[D2].Select
ActiveWorkbook.SaveAs Filename:=répertoire & "" & DemandeMat eriaux
MsgBox DemandeMateriaux & " sauvegardée"
ActiveWorkbook.Close
Sheets("DM").Select
[g2] = [g2] + 1
Range("B8:H48,D2,D3,D5,G3,G5,I5,D49").ClearContents
ActiveWorkbook.Save
End Sub- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -


JB, le bouton disparaît sans problème en revanche, c'est une image
en .jpg (logo de ma boite) qui disparaît à la suite de cette ligne la
de la macro
" [B1:I53].PasteSpecial Paste:=xlPasteValues"

A+ et encore merci
JP- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -


JB,

Rien à faire j'ai un plantage de la macro à:
ActiveSheet.Shapes("logo2").Left = 300
L'image insérée dans mon document source s'appelle logo2.jpg
Elle reste bien dans le document source mais n'est pas copiée alors
qu'elle est située dans la zone [B1:I53].Copy

Je te livre la macro complète avec les tests sur les cellules ayant
l'obligation d'être complétées.
Le fait d'avoir utilisé " ' " au lieu de supprimer la ligne ne change
rien?

Si tu as une solution, c'est bien sinon ne te prend pas la tête, je
vais continuer à chercher de mon coté.

Merci encore

Sub Sauvegarde()
' ActiveSheet.Protect Password:="dm", userinterfaceonly:=True
If [D2] = "" Then
MsgBox "Entrez le nom du demandeur SVP"
[D2].Select
Exit Sub
End If
If [D3] = "" Then
MsgBox "Entrez l'atelier demandeur"
[D3].Select
Exit Sub
End If
If [D5] = "" Then
MsgBox "Impuation à quel compte"
[D5].Select
Exit Sub
End If
If [I5] = "" Then
MsgBox "Entrez la date SVP"
[I5].Select
Exit Sub
End If
If [D49] = "" Then
MsgBox "Choisissez un fournisseur"
[D49].Select
Exit Sub
End If

répertoire = ActiveWorkbook.Path
DemandeMateriaux = "DM" & Format([g2], " 0000")
Sheets("DM").Copy
[B1:I53].Copy
[B1:I53].PasteSpecial Paste:=xlPasteValues
ActiveSheet.Shapes("logo2").Left = 300
ActiveSheet.Shapes("logo2").Top = 300
' For Each s In ActiveSheet.Shapes: s.Delete: Next s
[D2].Select
ActiveWorkbook.SaveAs Filename:=répertoire & "" & DemandeMateriaux
MsgBox DemandeMateriaux & " sauvegardée"
ActiveWorkbook.Close
Sheets("DM").Select
[g2] = [g2] + 1
Range("B8:H48,D2,D3,D5,G3,G5,I5,D49").ClearContents
ActiveWorkbook.Save

End Sub




Avatar
JB
Quand on clique sur une image, son nom apparaît en haut à gaucheb de
fx.

JB
On 21 fév, 20:03, wrote:
On 21 fév, 15:04, "JB" wrote:





Je suis surpris. Le collages spécial valeurs ne supprime pas les
images.
La boucle For Each s In ActiveSheet.Shapes: s.Delete: Next s a t-elle
bien été supprimée?

ActiveSheet.Shapes("xxx").Left00
ActiveSheet.Shapes("xxx").Top00

Permet de déplacer des Images.

JB

On 21 fév, 14:29, wrote:

On 21 fév, 14:15, "JB" wrote:

Bonjour,

Remplacer la boucle :

For Each s In ActiveSheet.Shapes: s.Delete: Next s

Par :

ActiveSheet.Shapes("xxx").Delete pour supprimer le bouton

JB

On 21 fév, 13:19, wrote:

De retour pour un conseil.
Ce matin je demandais déjà de l'aide sur cette macro. Tout fo nctionne
à merveille sauf qu'une image incluse dans la plage B1:I53 de
sauvegarde n'est pas copiée. Est-ce que quelqu'un peu m'aider s ur le
coup là?

Merci d'avance JP

Sub Sauvegarde()
ActiveSheet.Protect Password:="JP", userinterfaceonly:=True
répertoire = ActiveWorkbook.Path
DemandeMateriaux = "DM" & Format([g2], " 0000")
Sheets("DM").Copy
[B1:I53].Copy
[B1:I53].PasteSpecial Paste:=xlPasteValues
For Each s In ActiveSheet.Shapes: s.Delete: Next s
[D2].Select
ActiveWorkbook.SaveAs Filename:=répertoire & "" & DemandeM ateriaux
MsgBox DemandeMateriaux & " sauvegardée"
ActiveWorkbook.Close
Sheets("DM").Select
[g2] = [g2] + 1
Range("B8:H48,D2,D3,D5,G3,G5,I5,D49").ClearContents
ActiveWorkbook.Save
End Sub- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -


JB, le bouton disparaît sans problème en revanche, c'est une image
en .jpg (logo de ma boite) qui disparaît à la suite de cette lign e la
de la macro
" [B1:I53].PasteSpecial Paste:=xlPasteValues"

A+ et encore merci
JP- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -- Masquer le texte d es messages précédents -


- Afficher le texte des messages précédents -


JB,

Rien à faire j'ai un plantage de la macro à:
ActiveSheet.Shapes("logo2").Left = 300
L'image insérée dans mon document source s'appelle logo2.jpg
Elle reste bien dans le document source mais n'est pas copiée alors
qu'elle est située dans la zone [B1:I53].Copy

Je te livre la macro complète avec les tests sur les cellules ayant
l'obligation d'être complétées.
Le fait d'avoir utilisé " ' " au lieu de supprimer la ligne ne change
rien?

Si tu as une solution, c'est bien sinon ne te prend pas la tête, je
vais continuer à chercher de mon coté.

Merci encore

Sub Sauvegarde()
' ActiveSheet.Protect Password:="dm", userinterfaceonly:=True
If [D2] = "" Then
MsgBox "Entrez le nom du demandeur SVP"
[D2].Select
Exit Sub
End If
If [D3] = "" Then
MsgBox "Entrez l'atelier demandeur"
[D3].Select
Exit Sub
End If
If [D5] = "" Then
MsgBox "Impuation à quel compte"
[D5].Select
Exit Sub
End If
If [I5] = "" Then
MsgBox "Entrez la date SVP"
[I5].Select
Exit Sub
End If
If [D49] = "" Then
MsgBox "Choisissez un fournisseur"
[D49].Select
Exit Sub
End If

répertoire = ActiveWorkbook.Path
DemandeMateriaux = "DM" & Format([g2], " 0000")
Sheets("DM").Copy
[B1:I53].Copy
[B1:I53].PasteSpecial Paste:=xlPasteValues
ActiveSheet.Shapes("logo2").Left = 300
ActiveSheet.Shapes("logo2").Top = 300
' For Each s In ActiveSheet.Shapes: s.Delete: Next s
[D2].Select
ActiveWorkbook.SaveAs Filename:=répertoire & "" & DemandeMateriaux
MsgBox DemandeMateriaux & " sauvegardée"
ActiveWorkbook.Close
Sheets("DM").Select
[g2] = [g2] + 1
Range("B8:H48,D2,D3,D5,G3,G5,I5,D49").ClearContents
ActiveWorkbook.Save

End Sub- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -






Avatar
jpthillard
On 21 fév, 20:44, "JB" wrote:
Quand on clique sur une image, son nom apparaît en haut à gaucheb de
fx.

JB
On 21 fév, 20:03, wrote:



On 21 fév, 15:04, "JB" wrote:

Je suis surpris. Le collages spécial valeurs ne supprime pas les
images.
La boucle For Each s In ActiveSheet.Shapes: s.Delete: Next s a t-elle
bien été supprimée?

ActiveSheet.Shapes("xxx").Left00
ActiveSheet.Shapes("xxx").Top00

Permet de déplacer des Images.

JB

On 21 fév, 14:29, wrote:

On 21 fév, 14:15, "JB" wrote:

Bonjour,

Remplacer la boucle :

For Each s In ActiveSheet.Shapes: s.Delete: Next s

Par :

ActiveSheet.Shapes("xxx").Delete pour supprimer le bouton

JB

On 21 fév, 13:19, wrote:

De retour pour un conseil.
Ce matin je demandais déjà de l'aide sur cette macro. Tout fonctionne
à merveille sauf qu'une image incluse dans la plage B1:I53 de
sauvegarde n'est pas copiée. Est-ce que quelqu'un peu m'aider sur le
coup là?

Merci d'avance JP

Sub Sauvegarde()
ActiveSheet.Protect Password:="JP", userinterfaceonly:=True
répertoire = ActiveWorkbook.Path
DemandeMateriaux = "DM" & Format([g2], " 0000")
Sheets("DM").Copy
[B1:I53].Copy
[B1:I53].PasteSpecial Paste:=xlPasteValues
For Each s In ActiveSheet.Shapes: s.Delete: Next s
[D2].Select
ActiveWorkbook.SaveAs Filename:=répertoire & "" & Demand eMateriaux
MsgBox DemandeMateriaux & " sauvegardée"
ActiveWorkbook.Close
Sheets("DM").Select
[g2] = [g2] + 1
Range("B8:H48,D2,D3,D5,G3,G5,I5,D49").ClearContents
ActiveWorkbook.Save
End Sub- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -


JB, le bouton disparaît sans problème en revanche, c'est une im age
en .jpg (logo de ma boite) qui disparaît à la suite de cette li gne la
de la macro
" [B1:I53].PasteSpecial Paste:=xlPasteValues"

A+ et encore merci
JP- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -


JB,

Rien à faire j'ai un plantage de la macro à:
ActiveSheet.Shapes("logo2").Left = 300
L'image insérée dans mon document source s'appelle logo2.jpg
Elle reste bien dans le document source mais n'est pas copiée alors
qu'elle est située dans la zone [B1:I53].Copy

Je te livre la macro complète avec les tests sur les cellules ayant
l'obligation d'être complétées.
Le fait d'avoir utilisé " ' " au lieu de supprimer la ligne ne change
rien?

Si tu as une solution, c'est bien sinon ne te prend pas la tête, je
vais continuer à chercher de mon coté.

Merci encore

Sub Sauvegarde()
' ActiveSheet.Protect Password:="dm", userinterfaceonly:=True
If [D2] = "" Then
MsgBox "Entrez le nom du demandeur SVP"
[D2].Select
Exit Sub
End If
If [D3] = "" Then
MsgBox "Entrez l'atelier demandeur"
[D3].Select
Exit Sub
End If
If [D5] = "" Then
MsgBox "Impuation à quel compte"
[D5].Select
Exit Sub
End If
If [I5] = "" Then
MsgBox "Entrez la date SVP"
[I5].Select
Exit Sub
End If
If [D49] = "" Then
MsgBox "Choisissez un fournisseur"
[D49].Select
Exit Sub
End If

répertoire = ActiveWorkbook.Path
DemandeMateriaux = "DM" & Format([g2], " 0000")
Sheets("DM").Copy
[B1:I53].Copy
[B1:I53].PasteSpecial Paste:=xlPasteValues
ActiveSheet.Shapes("logo2").Left = 300
ActiveSheet.Shapes("logo2").Top = 300
' For Each s In ActiveSheet.Shapes: s.Delete: Next s
[D2].Select
ActiveWorkbook.SaveAs Filename:=répertoire & "" & DemandeMateria ux
MsgBox DemandeMateriaux & " sauvegardée"
ActiveWorkbook.Close
Sheets("DM").Select
[g2] = [g2] + 1
Range("B8:H48,D2,D3,D5,G3,G5,I5,D49").ClearContents
ActiveWorkbook.Save

End Sub- Masquer le texte des messages précédents -

- Afficher le texte des messages précédents -- Masquer le texte des messages précédents -


- Afficher le texte des messages précédents -


Merci JB!
L'image se nommait "Image 70" en fait il faut aussi la renommer en
"Image1" pour qu'elle soit acceptée.
Tout fonctionne bien. J'ai juste un peu tatonné pour fixer les
coordonnées de l'image. Je n'ai pas eu de solution pour avoir les
avoir dans le document source.
A+ JP