Logo copier sur un fichier et coller sur un autre fichier créé depuis le premier

[Gaby71]

Bonjour,

J'ai un fichier " BdD_RPL.xls " (ci-joint) avec sa macro qui crée un fichier " resultat_logo.xlsx "

comme les utilisateurs qui vont faire fonctionner cette macro n'auront pas le repertoire image , j'ai mis en premiere page mon logo pour que la macro la recupere et la colle comme indiqué dans le coin de la page du fichier " resultat_logo.xlsx "

mon fichier " BdD_RPL.xls " etant trop gros , j'ai mis seulement un extrait de la premiere page

Mais voilà , est-ce possible?

Merci d'avance

Cordialement

 

[camarchepas]

Re : Logo copier sur un fichier et coller sur un autre fichier créé depuis le premier

Bonjour ,

Voici une solution :

Sub auto_open()


'Création de la page "RPL"
    If MsgBox("Do you want create a RPL?", vbYesNo + vbQuestion, "Create File RPL") = vbYes Then
    Call Create_Workbook_RPL
    Call bandeau
    Call RPL_Cde
    Call addNPA
    Call Sauvegarde
    End If
End Sub
'-------------------------------------------------------------------
Sub Create_Workbook_RPL()

Dim nivurg As String


'Récupérer le nom du fichier de la BdD
nom_BdD = ActiveWorkbook.Name


'créer feuille RPL propre à la machine
    Workbooks.Add
    
    ActiveSheet.Name = "RPL"
    
UserForm1.Show
    Range("A3").Value = designation

    With Selection.Font
        .Name = "Arial"
        .Bold = True
        .Italic = True
        .Size = 18
    End With
    
    Columns("A:A").ColumnWidth = 4
    Columns("B:B").ColumnWidth = 60
    Columns("C:C").ColumnWidth = 18
    Columns("D:D").ColumnWidth = 9

 Dim NomIcone As String ' a mettre en début de routine 

 NomIcone = "Image 13", s'obtient dans la barre de formule a gauche lorsque l'on clic droit sur l'icone
 Pose_Icone NomIcone, 1, "A" 'Appel de la routine pour la pose de l'icone image 13 en A1
End Sub
'---------------------------------------------------------------------------  
Sub Pose_Icone(NomIcone As String, Lig As Long, Col As String)
Dim NomClasseur As String

NomClasseur = ActiveWorkbook.Name
ThisWorkbook.Activate
Sheets("Up date").Select
ActiveSheet.Shapes.Range(Array(NomIcone)).Select
Selection.Copy

With Workbooks(NomClasseur).Worksheets("RPL")
  .Activate
  .Range(Col & Lig).Select
  .Paste

  'Ajustement possible
  Selection.ShapeRange.IncrementTop -4
  Selection.ShapeRange.IncrementLeft 15
  Selection.ShapeRange.ScaleWidth 0.7407086364, msoFalse, msoScaleFromTopLeft
End With

End Sub

 

[Gaby71]

Re : Logo copier sur un fichier et coller sur un autre fichier créé depuis le premier

Bonjour

Merci beaucoup

voici le code final dont j'avais besoin

'ajout Logo

Workbooks(nom_BdD).Worksheets("Up date").Shapes("Image 13").Copy
Range("A1").Select
ActiveSheet.Paste

-------------------------------------------------------------------------------------------------------
("Up date"). etant l'onglet du fichier contenant le logo
("Image 13"). etant le nom du logo ( trouvé dans la zone de nom - en haut à gauche de l'écran)
le logo se copiant en "A1" du fichier resultat

Comme le logo a été dimensionné à la source - pas eu besoin de le faire avec la macro


Merci encore

A une prochaine sûrement