Multi Embedding - icons names & Sizes

CondeMontecristo

New Member
Joined
Oct 8, 2019
Messages
1
Hi all,

I was in need of a macro that embedded multiple files and I eventually got it. However, I need to resize the icons and get their names (file name / source name), as none of the names are shown but only blank icons. Although I thought I had captured this pieace in the code below, obviously I did not. Can anyone please give me a hand? I am struggling with the code and cannot find it out.

Sub Multiple_Embedding()


Dim mainWorkBook As Workbook
Dim flder As FileDialog
Dim folderpath As String
Set mainWorkBook = ActiveWorkbook
Set fso = CreateObject("Scripting.FileSystemObject")
Set flder = Application.FileDialog(msoFileDialogFolderPicker)


With flder
.Title = "Please select the folder where the files you wish to embed are saved into"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
folderpath = .SelectedItems(1)
End With


NextCode:
ChooseFolder = folderpath
Set flder = Nothing


NoOfFiles = fso.GetFolder(folderpath).Files.Count


Set listfiles = fso.GetFolder(folderpath).Files

On Error Resume Next




For Each fls In listfiles


Counter = Counter + 1


strCompFilePath = folderpath & "" & fls.Name


If strCompFilePath <> "" Then


ActiveSheet.OLEObjects.Add(Filename:=strCompFilePath, Link:= _
False, DisplayAsIcon:=True, IconIndex:=1, IconLabel:=strCompFilePath).Select


Sheets("Sheet1").Activate


Sheets("Sheet1").Range("B" & ((Counter - 1) * 3) + 1).Select

Else

Dim OleObj As OLEObjects
ActiveSheet.OLEObjects.Select
OleObj.ShapeRange.LockAspectRatio = msoFalse
OleObj.Height = 50
OleObj.Width = 50


End If


Next


mainWorkBook.Save


End Sub
 

Some videos you may like

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes

Watch MrExcel Video

Forum statistics

Threads
1,101,923
Messages
5,483,730
Members
407,406
Latest member
ishipra

This Week's Hot Topics

  • Finding issue in If elseif else with For each Loop
    Finding issue in If elseif else with For each Loop I have tried this below code but i'm getting in Y column filled with W005. Colud you please...
  • MsgBox Error
    Hi Guys, I have the below error show up when i try and run my macro in File1 but works fine if i copy and paste the same code into file2. [ATTACH...
  • CELL FORMAT - IF CONDITION
    My Cell Format is [B]""0.00" Cr". [/B]But in the cell, it is showing 123.00 for editing. (123 is entry figure). (Data imported from other...
  • Show numbers nearly the same
    Is this possible. I have a number that can change very time eg 0.00001234 Then I have a lot of numbers 0.0000001, 0.0000002, 0.00000004...
  • Please i need your help to create formula
    I need a formula in cell B8 to do this >>if b1=1 then multiply ( cell b8) by 10% ,if b1=2 multiply by 20%,if=3 multiply by 30%. Thank you in...
  • Got error while adding column and filter
    Got error while adding column and filter In column Z has some like "Success" and "Error". I want to add column in AA if the Z cell value is...
Top