Conserver les dimensions d une photo en arrière plan quelque soit la résolution du PC

[seb26000]

Bonsoir à tous,

J ai un gros souci. J ai un fichier oú je souhaite mettre une photo en arrière plan. Jusqu à là pas de problème. Là oú cela se complique, c est lorsque ce fichier est ouvert à partir d un autre PC disposant d une résolution différente. Dans ce cas les dimensions de la photo sont changées.
Donc comment faire pour sur la photo conserve la même taille malgrès des résolutions différentes ?

Merci d avance et bon WE !!!

 

[job75]

Re : Conserver les dimensions d une photo en arrière plan quelque soit la résolution

Bonjour seb26000,

Dans ce cas les dimensions de la photo sont changées.

Pas testé mais je pense que justement les dimensions de l'image ne changent pas.

Alors que vous souhaitez les modifier proportionnellement à la résolution de l'écran.

Alors copiez les macros suivantes :

1) dans un Module Standard (Alt+F11 => menu Insertion => Module) :

Public XEcran As Long, YEcran As Long 'mémorise les variables
Private Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
 
Sub ResolutionEcran()
XEcran = GetSystemMetrics(0)
YEcran = GetSystemMetrics(1)
End Sub

2) dans ThisWorkbook (en haut à gauche de la feuille VBA) :

Private Sub Workbook_Open()
Call ResolutionEcran
MsgBox "Résolution " & XEcran & " x " & YEcran 'facultatif bien sûr
On Error Resume Next 'si les noms n'ont pas encore été définis
With Sheets("Feuil1").Shapes("Image 1") 'feuille et image à adapter
  .LockAspectRatio = msoTrue 'conserve le rapport largeur/hauteur
  .Width = .Width * XEcran / [LargeurEcran] 'ajuste la largeur de l'image
End With
Me.Names.Add "LargeurEcran", XEcran
Me.Names.Add "HauteurEcran", YEcran
Me.Saved = True 'évite le message à la fermeture...
End Sub

Cette 2ème macro s'exécute à chaque ouverture du fichier.

Donc après avoir copié ces macros, enregistrez, fermez, puis rouvrez le fichier.

Edit : j'ai ajouté Me.Saved = True pour éviter le message à la fermeture.

Enregistrez le fichier après la 1ère ouverture pour que les noms LargeurEcran et HauteurEcran soient bien créés.

A+

 

[job75]

Re : Conserver les dimensions d une photo en arrière plan quelque soit la résolution

Re,

Pour la macro dans ThisWorkbook, on peut préférer ceci :

Private Sub Workbook_Open()
Dim k As Double
Call ResolutionEcran
MsgBox "Résolution " & XEcran & " x " & YEcran 'facultatif bien sûr
On Error Resume Next 'si les noms n'ont pas encore été définis
With Sheets("Feuil1").Shapes("Image 1") 'feuille et image à adapter
  .LockAspectRatio = msoTrue 'conserve le rapport largeur/hauteur
  k = Application.Max(XEcran / [LargeurEcran], YEcran / [HauteurEcran])
  If k Then .Width = .Width * k 'ajuste la largeur de l'image
End With
Me.Names.Add "LargeurEcran", XEcran
Me.Names.Add "HauteurEcran", YEcran
Me.Saved = True 'évite le message à la fermeture...
End Sub

Edition : ceci est mieux, les 3 noms sont créés seulement à la 1ère ouverture :

Private Sub Workbook_Open()
Dim k As Double
Call ResolutionEcran
MsgBox "Résolution " & XEcran & " x " & YEcran 'facultatif bien sûr
On Error Resume Next 'si les noms n'ont pas encore été définis
With Sheets("Feuil1").Shapes("Image 1") 'feuille et image à adapter
  .LockAspectRatio = msoTrue 'conserve le rapport largeur/hauteur
  k = Application.Max(XEcran / [LargeurEcran], YEcran / [HauteurEcran])
  If k Then .Width = [LargeurImage] * k 'ajuste la largeur de l'image
  Me.Saved = True 'évite le message à la fermeture...
  If Err Then 'création des noms à la 1ère ouverture
    Me.Names.Add "LargeurEcran", XEcran
    Me.Names.Add "HauteurEcran", YEcran
    Me.Names.Add "LargeurImage", .Width
  End If
End With
End Sub

A+

 

[seb26000]

Re : Conserver les dimensions d une photo en arrière plan quelque soit la résolution

Merci à vous 2 c est vrai super sympa de m aider. Je vais essayer cela ce we et je vous tiens au courant.
Merci encore et bon we !

 

[seb26000]

Re : Conserver les dimensions d une photo en arrière plan quelque soit la résolution

Bonsoir

Je viens de tenter les macros
J ai un soucis a la fermeture du fichier. J ai un message d Excel disant qu il a rencontré un problème et doit tout fermé... Est normal docteur ????

 

[job75]

Re : Conserver les dimensions d une photo en arrière plan quelque soit la résolution

Bonjour seb26000, le forum,

Je ne sais pas pourquoi Excel plante chez vous. Problème avec l'API Windows GetSystemMetrics Lib "user32.dll" ??

Indiquez vos versions Windows et Excel pour que d'autes XLDnautes nous disent ce qu'il en est.

Je suis sous Windows 7 et Excel 2010, je n'ai aucun problème avec ces macros.

Nota : j'ai édité mon post #3 avec une solution meilleure.

A+

 

[job75]

Re : Conserver les dimensions d une photo en arrière plan quelque soit la résolution

Re,

Essayez aussi cette modification pour les macros dans le Module standard :

Private Declare Function GetSystemMetrics Lib "user32.dll" (ByVal nIndex As Long) As Long
Const SM_CXSCREEN = 0
Const SM_CYSCREEN = 1
Public XEcran As Long, YEcran As Long 'mémorise les variables

Sub ResolutionEcran()
XEcran = GetSystemMetrics(SM_CXSCREEN)
YEcran = GetSystemMetrics(SM_CYSCREEN)
End Sub

Edit : voir ce (vieux) fil qui semble-t-il n'a rien résolu :

https://www.excel-downloads.com/threads/plantage-dexcel-a-cause-dun-appel-dll-en-vba.80904/

A+

 

[job75]

Re : Conserver les dimensions d une photo en arrière plan quelque soit la résolution

Bonjour seb26000, le forum,

Une solution pérenne qui se passe des API Windows.

Dans Module1 :

Sub AdapteImage()
Application.WindowState = xlMaximized
With Feuil1.Shapes("Image 1") 'feuille et image à adapter
  .LockAspectRatio = msoTrue
  .Width = ActiveWindow.Width
  If .Height < ActiveWindow.Height Then .Height = ActiveWindow.Height
  .Top = 0
  .Left = 0
End With
End Sub

Dans ThisWorkbook :

Private Sub Workbook_Open()
AdapteImage
End Sub

Pour tester télécharger ce fichier :

Cijoint.fr - Service gratuit de dépôt de fichiers

A+

 

[job75]

Re : Conserver les dimensions d une photo en arrière plan quelque soit la résolution

Re,

J'ai édité le post précédent avec une solution pérenne et très simple.

A+

 

[seb26000]

Re : Conserver les dimensions d une photo en arrière plan quelque soit la résolution

Salut Job75 !

Merci pour ton aide. Je viens de tester, ça marche très bien par contre j'ai 2 questions :
1. Comment faire pour que cette image qui vient d'être redimensionnée, aille en arrière plan et non en premier plan car j'ai des cellules qui sont remplies
2. Je vois que l'image s'appelle Image 1. J'ai insérer une image à moi et je n'arrive pas à l'appeler "Image 1" alors que j'ai supprimé celle en exemple dans ton fichier. J'ai pourtant fait "Insertion" puis "Nom" et Excel me met Image 69 donc j'ai modifié ta macro pour que ca marche... Comment faire pour la nommée "Image 1" ???
Merci beaucoup de ton aide si précieuse !!

A++++

 

[seb26000]

Re : Conserver les dimensions d une photo en arrière plan quelque soit la résolution

J'ai encore une dernière petite question, à l'ouverture Feuil1 est visible jusqu'à la colonne S et la ligne 48. Comment faire pour que la fenetre reste figer. J'ai bien fait disparaitre l'ascenseur horizontal et vertical pour éviter d'aller au delàs de ces limites mais il est toujours possible de naviguer avec les fleches du clavier.
En résumé j'aimerais que l'utilisateur ne navigue pas dans l'onglet...

A++++

 

[job75]

Re : Conserver les dimensions d une photo en arrière plan quelque soit la résolution

Bonjour seb26000,

1. Pour créer un Arrière-plan, il faut utiliser un fichier image (JPEG par exemple) :

- sous Excel 2003 (de mémoire) : menu Format => Feuille => Arrière-plan

- sous Excel 2007 : onglet Mise en page => Arrière-plan.

L'image d'arrière-plan n'est pas accessible, donc pas modifiable.

Mais on peut toujours la recréer. Si vous voulez connaître le code, utilisez l'enregistreur de macro.

2. Pour modifier le nom d'une image, sélectionner l'image (clic droit) puis en haut à gauche modifier le nom et valider par Ctrl+Entrée.

3. Pour éviter le défilement par les touches de défilement ou par la touche <Entrée>, le plus simple est de protéger la feuille en décochant l'option "Sélectionner les cellules verrouillées".

 

[seb26000]

Re : Conserver les dimensions d une photo en arrière plan quelque soit la résolution

ok

Merci beaucoup Job75 !!!!

Bonne journée et bon WE !!

 

[job75]

Re : Conserver les dimensions d une photo en arrière plan quelque soit la résolution

Re,

Il faut apporter 2 corrections à ce qui précède.

1) Pour le défilement, il y a aussi la roulette (appelée aussi molette)...

En fait le mieux est de fractionner la fenêtre horizontalement, le 1er volet contenant toute l'image.

Ensuite on fige les volets et on protège la feuille.

2) Positionner l'image avec ses propriétés Top et Left n'est pas bon.

Il faut la positionner manuellement une fois pour toutes dans le coin supérieur gauche de la feuille.

Voici la nouvelle macro :

Sub AdapteImage()
Feuil1.Activate
Feuil1.Unprotect "SEB"
Application.WindowState = xlMaximized
ActiveWindow.WindowState = xlMaximized
With Feuil1.Shapes("Image 1") 'feuille et image à adapter
  .LockAspectRatio = msoTrue
  .Width = ActiveWindow.Width
  If .Height < ActiveWindow.Height Then .Height = ActiveWindow.Height
End With
With ActiveWindow
  .FreezePanes = False
  .SplitRow = 500
  .FreezePanes = True
End With
Feuil1.Protect "SEB"
End Sub

Notez bien le mot de passe SEB.

Voici le nouveau fichier :

Cijoint.fr - Service gratuit de dépôt de fichiers

A+

 

[seb26000]

Re : Conserver les dimensions d une photo en arrière plan quelque soit la résolution

Merci beaucoup Job 75 ! C'est vraiment génial de ta part !!!

J'ai un autre soucis maintenant qui concernant la compatibilité des versions 2003 et 2007. Je vais faire un nouveau poste. Le fichier a été réalisé à partir de Excel 2003.
Je viens de l'ouvrir avec Excel 2007 (logiciel de mon employeur). Là pas de souci. Or j'ai noté que le fichier met très longtemps à s'enregistrer sous cette version alors que sous 2003 ce n'était pas le cas.
J'ai donc opté pour le convertir en xlsm (format pour intégrer les macro sous excel 2007). Et là c'est le drame lorsque j'ai ouvert ce fichier, j'ai plein de message d'erreurs et je n'ai plus rien dans ce fichier...

Merci encore Job de ton aide !!

A+