Créer des fiches renseignées à partir d'un tableau

Si tu mets un format carré pour la première elle sera moins déformée mais c'est la deuxième qui sera plus déformé.

Si tu modifies le format des photos tu te débrouilles avec tu as ! Tu as l'original de mes téléchargements : YAKA regarder les dimensions que j'ai donné à chaque image (dans la fenêtre des propriétés) Tu le note en commentaire dans un coin de ton VBA et en cas de maladresse c'est pas sorcier de le rétablir comme d'origine... YAPA de raison que ce format change tout seul. Après si tu veux enlever 50 ou 100 pixel d'un coté c'est pas compliqué d'en rajouter 50 ou 100 de l'autre....

Les vues étant en mode stretch c'est la photo elle même qui s'ajuste au rectangle image. Mais il y a a grand intérêt à ce que tes originaux soit au format 300 x 400 parce que il n'y a pas que la distorsion qui joue il y a aussi le poids du classeur donc le coté vélocité de chargement qui joue : Je me suis décarcassé pour annulé l'effet 4 méga à la sortie pour éviter que ton classeur devienne pas puable au bout de quinze jours mais encore une fois un classeur excel c'est pas fait pour jouer avec les images, pas plus qu'avec des ébauches de romans fleuves : Entre la peste ou le choléra toi tu demandes de choisir la peste ET le choléra... Là tu te débrouilles mon ami...

Pour ce texte tu peux peut-être essayer de jouer sur la mise en page en rajouter 2 lignes à ta zone d'impression... 2 lignes sur une feuilles A3 ça te laisse déjà le loisir de mettre en valeur ta prose... (en dessous les photos). Après l'ajustement va se jouer sur l'effet zoom au moment de l'impression. Tu te débrouilles pour zoomer sur une page en largeur ou une page en hauteur comme ça te va le mieux... Mais moi je prend pas en charge. Parce que j'ai autre chose à faire qu'à jouer sur 1 ou 2 pixels en plus ou en moins sur la taille de tes images... Tu peux même jouer sur l'intervalle entre les images : De mémoire comme ça il doit y avoir au moins 8 ou 10 pixels entre chaque image : A toi de voir si en rognant sur ces marges intermédiaires ça t'arrange...

Bref j'ai fait le gros œuvre , le moins que tu puisses faire c'est de t'occuper des finitions... Et de toute façons il n'y a rien dans le code qui t'empêche de te régler comme tu veux puisque le code se contente de charger et décharger les images.

A+

Ok. Je vais voir ce que j'arrive à faire moi-même maintenant. Merci pour ton boulot galopin01 !

Bonjour, galopin01, Kmi22, MFerrand , le forum

Pour la création automatique de fiches, tu aurais pu procéder comme ceci :

J'ai un peu changé la disposition des données restituées.

Concernant le traitement des images, galopin01 a tout dit et je ne m'y aventurerai pas, je n'aurais pas su le faire

Option Explicit
Sub creation_fiches()
Dim a, e, s, i As Long, j As Long, n As Long
Dim txt As String, dico As Object
    a = Sheets("Tab").[a1].CurrentRegion.Value
    For j = 1 To UBound(a, 2)
        If a(1, j) = "" Then a(1, j) = a(1, j - 1)
    Next
    Set dico = CreateObject("Scripting.Dictionary")
    For i = 3 To UBound(a, 1)
        txt = Join$(Array(a(2, 1), a(i, 1), a(i, 2)), "|")
        Set dico(txt) = CreateObject("Scripting.Dictionary")
        dico(txt).Comparemode = 1
        For j = 3 To UBound(a, 2) - 1
            If Not dico(txt).exists(a(1, j)) Then
                Set dico(txt)(a(1, j)) = CreateObject("Scripting.Dictionary")
            End If
            dico(txt)(a(1, j))(a(2, j)) = a(i, j)
        Next
    Next
    Application.ScreenUpdating = False
    For Each e In dico.keys
        On Error Resume Next
        Application.DisplayAlerts = False
        Sheets(Split(e, "|")(2)).Delete
        'Sheets.Add().Name = Split(e, "|")(2)
        Sheets.Add(Before:=Sheets("Tab")).Name = Split(e, "|")(2)
        On Error GoTo 0
        n = 1
        With Sheets(Split(e, "|")(2))
            With .Cells(n, 1).Resize(, 2)
                With .EntireColumn
                    .NumberFormat = "@"
                    .Font.Name = "calibri"
                    .VerticalAlignment = xlCenter
                End With
                .Value = Array(Split(e, "|")(0) & " " & Split(e, "|")(1), Split(e, "|")(2))
                .Font.Size = 11
                .HorizontalAlignment = xlCenter
                .BorderAround Weight:=xlThin
                .Interior.ColorIndex = 40
            End With
            n = n + 2
            For Each s In dico.Item(e).keys
                With .Cells(n, 1)
                    .Value = s
                    .Offset(1).Resize(dico(e).Item(s).Count).Value = Application.Transpose(dico(e).Item(s).keys)
                    .Offset(1, 1).Resize(dico(e).Item(s).Count).Value = Application.Transpose(dico(e).Item(s).items)
                    With .Resize(dico(e).Item(s).Count + 1, 2)
                        With .Offset(1).Resize(.Rows.Count - 1)
                            .BorderAround Weight:=xlThin
                            .Borders(xlInsideVertical).Weight = xlHairline
                            .Font.Size = 9
                        End With
                        With .Rows(1)
                            .HorizontalAlignment = xlCenterAcrossSelection
                            .BorderAround Weight:=xlThin
                            .Interior.ColorIndex = 36
                            .Font.Size = 10
                        End With
                    End With
                End With
                n = n + dico(e).Item(s).Count + 2
            Next
            With .Cells(1).EntireColumn.Resize(, 2)
                .AutoFit
            End With
        End With
    Next
    Sheets("Tab").Move Before:=Sheets(Split(dico.keys()(0), "|")(2))
    Set dico = Nothing
    Application.ScreenUpdating = True
End Sub

Beau travail galopin01

klin89

Bonjour Klin89,

Merci de te joindre à galopin01 et MFerrand pour me donner un coup de main !

J'ai téléchargé le fichier que tu as posté mais il n'a pas d'onglet Fiche, comment les créer ? (Je pars de zéro pour les macros ) Si je vais dans Affichage > Macros > Enregistrer une macro, j'aurais bien copié-collé le code que tu as rédigé mais apparemment ce n'est pas ça qu'il faut faire Où est-ce qu'il faut que je le colle ?

Bonne journée !

Bonjour Kmi22, et tous...

Très gentil à toi de m'associer... Je reste à l'écoute, certes... mais il ne t'a point échappé que je me borne à observer depuis que Galopin a pris les rênes. Il n'a nul besoin d'assistance, et comme toujours, une fois que le plan d'ensemble apparaît à peu près élaboré, les choses prennent vite une tournure définitive, et l'on en est aux détails de finition...

Cordialement.