Charger une image ou fichier dans excel via macro - VB/VBA/VBS - Programmation
Marsh Posté le 11-09-2014 à 08:47:40
bon je vois que c'est un peu fouillis ^^ car 75 vues sans réponse ça me parait étrange ^^
on va changer un peu ^^ je m'occuperais de compiler les 3 macros que je vais vous demander :
1°) il me faudrait une cellule (J8) avec le chemin du fichier type : C:\UtIlItAiRe\accis\Macro\Excel\Nouveau dossier\
2°) il faudrait enregistrer sous se chemin de la cellule (J8) qui varie selon le dossier où ce trouvce le fichier (faisable sous autocad mais sous excel je sais pas)
3°) Charger le fichier nommer dans la cellule (J9) dans ce meme chemin de fichier ^^ donc 1 puis 2 etc ce chercherais le fichier nommer 1,2...
Bon dsl et merci d'avance
si je suis pas assez clair dite le moi ^^
Marsh Posté le 11-09-2014 à 15:54:43
Bonjour,
pas de réponse certainement à cause de plusieurs incartades aux règles du forum : les lire donc …
Marsh Posté le 12-09-2014 à 16:42:34
Bonjour,
merci de votre réponse, j'ai lu et donc relu les règles : peut etre parlez -vous de celle ci :
Citation : [0C] On ne fait pas le boulot à votre place. |
Pourtant je ne demande pas un programme ou macro complete puisque 70% ont fait via des recherches
Si je me trompe, j'éditerais mon 1ier message pour le supprimer ou le signaler ^^ merci ^^
Marsh Posté le 12-09-2014 à 17:58:38
Doit bien y avoir un point dans les règles du forum demandant de poster le code entre balises …
Y a même une icône pour cela ‼
Ensuite expliquer clairement un besoin ou une difficulté rencontrée, un point précis à la fois,
en indiquant après avoir balisé le code le numéro de la ligne en question.
Cela devrait peut-être motiver d'éventuels intervenants à répondre …
Marsh Posté le 05-09-2014 à 15:57:27
Bien le bonjour a tous,
Oui tous car ceci est mon premier message sur ce forum d'aide et d'entraide !!!
Premiere question :
il y a t'il un forum de présentation par hasard ?
Ensuite :
pour mon travail, j'ai fusionner 2 macros dans une qui font que :
1°) itération et activation d'une macro manuel apres l'itération
2°) Recherche d'une image manuel (important pour la suite)
3°) enregistrement suivant le nombre qui est donc une itération (il change a chaque F9 comme beaucoup le save !!!)
c'est pas trop mal, sauf que l'erreur étant humaine :
Lorsque j'ai plus de 300 à 400 photo chercher l'image deviennes un peu long ^^ et desfois j'en saute une ou je reprends la meme etc... (rare mais quand sa arrive )
donc si quelqu'um pouvais m'aider a chargé les images : 1,2 etc jusqu'a ce qu'il n'y est plus d'image dans le dossier a traiter ça m'aiderais beaucoup ^^ ou alors que j'entre le nombre d'image dans une cellule pour qu'il s'arrete
le but étant que faire que du F9 ^^ et active macro ^^ car les boucles sont un peu complexe pour moi !!
a et oui chose importante je vais mettre les fichiers excel dans le meme dossier que les image comme ça plus facile et pas de risque d'erreur ^^
Voila ^^ bon je vous donne ma base prenez en soin : et merci !
Sub insere_image_ratio()
Dim ficimg As String, Ad As String
Dim MemW As Long, MemH As Long, T As Integer, L As Integer
Dim Lg As Integer, HT As Integer, RatioCell As Single
Dim CellH As Long, CellW As Long, RatioHz As Single, RatioVt As Single
Dim NomFichier As String
Ad = Selection.Address
CellH = Selection.Height
CellW = Selection.Width
ficimg = Application.GetOpenFilename(".jpg,*.jpg", , "Choisissez l'image" ) ' choix nom du fichier
If ficimg = "Faux" Then Exit Sub
ActiveSheet.Pictures.Insert(ficimg).Select ' insertion
With Selection.ShapeRange
MemW = .Width: MemH = .Height
'adapte les ratio
If MemH < CellH And MemW < CellW Then
'l'image < cellule
RatioHz = MemH / CellH
RatioVt = MemW / CellW
If RatioVt < RatioHz Then 'adapter en hauteur
HT = CellH: Lg = MemW * (HT / MemH)
T = 0: L = (CellW - Lg) / 2
Else 'adapter en largeur
Lg = CellW: HT = MemH * (CellW / MemW)
L = 0: T = (CellH - HT) / 2
End If
ElseIf MemH > CellH And MemW > CellW Then
'l'image > cellule
RatioHz = CellH / MemH
RatioVt = CellW / MemW
If RatioVt > RatioHz Then 'adapter en hauteur
HT = CellH: Lg = MemW * (HT / MemH)
T = 0: L = (CellW - Lg) / 2
Else 'adapter en largeur
Lg = CellW: HT = MemH * (Lg / MemW)
L = 0: T = (CellH - HT) / 2
End If
ElseIf MemH > CellH And MemW < CellW Then
'adapter en hauteur
HT = CellH: Lg = MemW * (HT / MemH)
T = 0: L = (CellW - Lg) / 2
ElseIf MemH < CellH And MemW > CellW Then
'adapter en largeur
Lg = CellW: HT = MemH * (Lg / MemW)
L = 0: T = (CellH - HT) / 2
Else
Stop ' pas prévu ?
End If
.LockAspectRatio = False ' proportions d'origine lorsque vous la redimensionnez
.Top = Range(Ad).Top + T ' haut de la cellule
.Left = Range(Ad).Left + L ' gauche de la cellule
.Height = HT
.Width = Lg ' largeur des cellules fusionnées
End With
With Selection
.Placement = xlMoveAndSize
.PrintObject = True
End With
NomFichier = Range("J9" ) ' Recherche la valeur d'une cellule pour enregistrer sous le nom de cellule
ActiveWorkbook.SaveAs "C:\UtIlItAiRe\accis\Macro\Excel\Nouveau dossier\" & NomFichier ' répertoire sous
End Sub