IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

macro insertions images et redimensionnement [XL-2003]


Sujet :

Macros et VBA Excel

Mode arborescent

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Nouveau membre du Club
    Profil pro
    Inscrit en
    Septembre 2007
    Messages
    6
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Septembre 2007
    Messages : 6
    Par défaut macro insertions images et redimensionnement
    Bonjour à tous !
    Voici ce que je voudrais faire : Je dois générer des "fiches d'identité" de différents éléments de réseaux d'eau usée et potable. La fiche type est déjà prête.
    Pour le moment, mon fichier excel comporte deux feuilles : "base de données" et "EU (1)"
    la "base de données" contient tous les renseignements relatif à chaque élément du réseau, y compris une case pour le suffixe de la photo, et son numéro (exemple : suffixe DSCF et numéro de photo 003). Pour le moment, j'ai crée un spinbouton qui permet de remplir toute la fiche EU (1) à partir des éléments de base de donnée, en fonction du numéro de l'élément (simple copie de case à case).
    Maintenant, ce que je voudrais faire, c'est aller chercher la photo correspondant à l'élément du réseau, l'insérer au bon endroit dans la fiche EU, et redimensionner la photo de façon à ce qu'elle rentre dans l'espace prévu, quelle que soit sa taille ou son orientation, en conservant ses proportions d'origine. Pour le moment, j'ai bricolé ça :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    Private Sub SpinButton1_Change()
    Dim Image As Variant 'variable "nom du fichier"
    Dim sh As Shape ' variable pour image à effacer
    Dim L, T, W, H As Single 'futures dimensions de l'image
    Dim R, C, P As String ' variables "numéro de photo"
    
    ActiveSheet.[A20].Select 'sélection de la cellule cible dans EU (1)
    
    'sélection de la cellule cible
    L = 15  ' ActiveCell.Left
    T = ActiveCell.Top
    W = 210
    H = 210
    
    For Each sh In ActiveSheet.Shapes ' Boucle d'effacement de l'image précédente
        If Not Intersect(Range(sh.TopLeftCell.Address), Range("A20:D33")) Is Nothing Or _
            Not Intersect(Range(sh.BottomRightCell.Address), Range("A20:D33")) Is Nothing Then
            sh.Delete
        End If
    Next sh
    
    R = ActiveSheet.[H6].Value * 8 - 5 'prend le numéro de l'élément défini par le spinbouton et ajoute 8 lignes correspondantes aux informations de chaque élément sur la feuille "base de données"
    P = Sheets("Base de données").Cells(R, 14).Value 'numéro de la photo dans la feuille base de données
    Set suffixe = Sheets("Base de données").Cells(R, 13).Value 'là, j'ai un problème...
        If Sheets("Base de données").Cells(R, 14).Value = "" Then 'si pas de photo
           ' il faudrait sortir de la macro...    
            Else
            Image = Application.ActiveWorkbook.Path + "\photos\" + suffixe + P + ".JPG" 'select° photo
                   
                If Image <> False Then 'si taille photo différente de cellule
                    ActiveSheet.Shapes.AddPicture Image, True, True, L, T, W, H 'redimensionne
                End If
       
        End If
    'Insertion du radiant
    Sheets("Base de données").Select
    ActiveSheet.Shapes("Groupe 2").Select
    Selection.Copy
    Sheets("EU (1)").Select
    Range("A20 : D33").Select
    ActiveSheet.Paste
    Selection.ShapeRange.IncrementLeft 15
    Selection.ShapeRange.IncrementTop 9.75
    
    'générer la fiche dans une nouvelle feuille et passer à la suivante
    Sheets("EU (1)").Select
    Sheets("EU (1)").Copy After:=Sheets(2)
    'il manque une boucle pour passer à l'élément n°2
    End Sub
    Donc mon gros problème, c'est que les suffixes DSCF etc... ne sont pas toujours les même et le nombre d'élément est parfois trop important pour renommer une à une les photos. Je voudrais que la macro trouve la photo à partir du suffixe défini dans la case R,13 de "base de données", de son numéro en R,14, ensuite qu'elle l'insère dans EU, garde les proportions et la redimensionne (sachant que dans mon code, je fixe les dimensions au départ, et ça déforme la photo; ce n'est pas ce que je voudrais).
    Ensuite, il faudrait que la fiche ainsi crée soit copier en une nouvelle feuille en dernier, et on passe à l'élément 2, et ainsi de suite jusqu'à ce qu'il n'y ait plus de numéro d'élément.
    pouvez-vous m'aider à réparer/modifier cette macro ? Je vous en remercie beaucoup par avance.
    Cordialement

    PS : je l'ai créer sous Excel 2003 car :
    c'est celui que j'ai chez moi !
    Plus facile d'accéder au VBA et aux macros (en tout cas pour moi)
    Par contre, au boulot, c'est Office 2007 (pb de compatibilité ?).
    Images attachées Images attachées  

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [OpenOffice][Texte] [Macro] Insertion image - Ooo 3.3
    Par djibril dans le forum OpenOffice & LibreOffice
    Réponses: 1
    Dernier message: 22/06/2011, 09h57
  2. [PPT-2010] Macro Insertion Image depuis Excel
    Par fidecourt dans le forum VBA PowerPoint
    Réponses: 4
    Dernier message: 18/01/2011, 18h08
  3. insertion image avec macro sans doublon lors de la réexécution
    Par picogunsy dans le forum Macros et VBA Excel
    Réponses: 7
    Dernier message: 08/07/2010, 15h24
  4. insertion image avec une macro pour word
    Par bricoleur76 dans le forum VBA Word
    Réponses: 3
    Dernier message: 12/03/2009, 22h14
  5. [VBA-E] Macro Insertion image
    Par dafalri dans le forum Macros et VBA Excel
    Réponses: 3
    Dernier message: 24/05/2006, 17h20

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo