Bonjour,
J'ai une macro qui insère automatiquement des photos dans les cases Excel en fonction de la référence donnée. Les photos sont toutes stockées sur un serveur commun à l'entreprise, et on pour nom reference.jpg
Cela fonctionne super bien. Sauf que lorsque j'envoie un fichier Excel à l’extérieur de mon entreprise, les photos ne s'affichent pas, fameuse croix rouge et un message qui dit que Excel ne peut télécharger les photos.
C'est une macro que je traîne depuis des années et que je modifie d'entreprise en entreprise, en général juste le chemin d'accès au serveur. Je ne sais pas si c'est lié à une version d'Excel ou quoi, mais jusque là je n'avais jamais eu de soucis. C'est un informaticien qui l'avait construite et je vous avouerai ne pas comprendre tout le code...!
Est-ce que quelqu'un parmi vous aurait la solution ? Je ne sais pas, modifier les paramètres de la photo une fois importée pour qu'elle reste en dur dans le fichier par exemple ?...
MERCI !!!!
Le code de la macro:
----------------------------------------------
Sub Macro_Photo()
Dim rngTmp As Range
Dim rowTmp As Range
Dim rngInsert As Range
Dim tmpFamily As String
Dim tmpPath As String
Dim tmpFile As String
Dim tmpFileOrig As String
Dim cell_photo As Range
Dim img As Object
Set rngTmp = Selection
tmpFile = "Ces articles n'existent pas en photo"
tmpFileOrig = tmpFile
Dim posColstr As String
Dim posCol As Integer
posColstr = InputBox("En quelle colonne voulez-vous inserer vos photos (1, 2, 3...)?", "Colonne", 1)
posCol = CInt(posColstr)
If posCol = 0 Then posCol = 1
For Each rowTmp In rngTmp.Rows
tmpFamily = Mid(rowTmp.Cells(1, 1), 4, 2)
tmpPath = "\\10.0.1.185\projects\COMMUN\PHOTOS skus" + "\" + CStr(rowTmp.Cells(1, 1)) + ".jpg"
If Dir(tmpPath) <> "" Then
ActiveSheet.Cells(rowTmp.Cells(1, 1).Row, rowTmp.Cells.Column).Select
ActiveSheet.Cells(Selection.Row, posCol).Select
ActiveSheet.Pictures.Insert(tmpPath).Select
dblFactorH = rowTmp.Height / Selection.Height * 0.8
Selection.Name = rowTmp.Cells(1, 1)
' Selection.ShapeRange.ScaleWidth dblFactorW, msoFalse, msoScaleFromTopLeft'
Selection.ShapeRange.ScaleHeight dblFactorH, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.IncrementLeft 4
Selection.ShapeRange.IncrementTop 2
Else
tmpFile = tmpFile + vbCrLf + rowTmp.Cells(1, 1)
End If
Next rowTmp
If tmpFile <> tmpFileOrig Then
MsgBox tmpFile
End If
End Sub
J'ai une macro qui insère automatiquement des photos dans les cases Excel en fonction de la référence donnée. Les photos sont toutes stockées sur un serveur commun à l'entreprise, et on pour nom reference.jpg
Cela fonctionne super bien. Sauf que lorsque j'envoie un fichier Excel à l’extérieur de mon entreprise, les photos ne s'affichent pas, fameuse croix rouge et un message qui dit que Excel ne peut télécharger les photos.
C'est une macro que je traîne depuis des années et que je modifie d'entreprise en entreprise, en général juste le chemin d'accès au serveur. Je ne sais pas si c'est lié à une version d'Excel ou quoi, mais jusque là je n'avais jamais eu de soucis. C'est un informaticien qui l'avait construite et je vous avouerai ne pas comprendre tout le code...!
Est-ce que quelqu'un parmi vous aurait la solution ? Je ne sais pas, modifier les paramètres de la photo une fois importée pour qu'elle reste en dur dans le fichier par exemple ?...
MERCI !!!!
Le code de la macro:
----------------------------------------------
Sub Macro_Photo()
Dim rngTmp As Range
Dim rowTmp As Range
Dim rngInsert As Range
Dim tmpFamily As String
Dim tmpPath As String
Dim tmpFile As String
Dim tmpFileOrig As String
Dim cell_photo As Range
Dim img As Object
Set rngTmp = Selection
tmpFile = "Ces articles n'existent pas en photo"
tmpFileOrig = tmpFile
Dim posColstr As String
Dim posCol As Integer
posColstr = InputBox("En quelle colonne voulez-vous inserer vos photos (1, 2, 3...)?", "Colonne", 1)
posCol = CInt(posColstr)
If posCol = 0 Then posCol = 1
For Each rowTmp In rngTmp.Rows
tmpFamily = Mid(rowTmp.Cells(1, 1), 4, 2)
tmpPath = "\\10.0.1.185\projects\COMMUN\PHOTOS skus" + "\" + CStr(rowTmp.Cells(1, 1)) + ".jpg"
If Dir(tmpPath) <> "" Then
ActiveSheet.Cells(rowTmp.Cells(1, 1).Row, rowTmp.Cells.Column).Select
ActiveSheet.Cells(Selection.Row, posCol).Select
ActiveSheet.Pictures.Insert(tmpPath).Select
dblFactorH = rowTmp.Height / Selection.Height * 0.8
Selection.Name = rowTmp.Cells(1, 1)
' Selection.ShapeRange.ScaleWidth dblFactorW, msoFalse, msoScaleFromTopLeft'
Selection.ShapeRange.ScaleHeight dblFactorH, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.IncrementLeft 4
Selection.ShapeRange.IncrementTop 2
Else
tmpFile = tmpFile + vbCrLf + rowTmp.Cells(1, 1)
End If
Next rowTmp
If tmpFile <> tmpFileOrig Then
MsgBox tmpFile
End If
End Sub
