Making a catalog of pictures
2
$begingroup$
Is there a way to make this code run faster? I have over 6000 pictures in .jpg optimized to a maximum of 40 kB. It starts quickly but after like 2000 pictures it runs way slower. The final .xlsm file is about 380 MB.
I'm using Excel 2016 with Windows 10 on a big server with 16 processors and 80 GiB RAM.
Sub Button5_Click()
With Excel.Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.DisplayStatusBar = False
.EnableEvents = False
End With
With Worksheets
DisplayPageBreaks = False
End With
ChargeTrombinoscope
With Excel.Application
.EnableEvents = True
.DisplayStatusBar = True
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
With Worksheets
DisplayPageBreaks = True
End With
''''CheckImageName
End Sub
Sub ChargeTrombinoscope()
Dim Chemin As String, Fichier As String
Dim nom, nom As String
Dim splitArr() As String
Dim Ligne As Integer
Dim Largeur As Integer
Dim Hauteur As Integer
Dim h As Long, Rapport As Single
Const hDefaut = 97
Worksheets("Pix").Activate
'Définit le répertoire contenant les fichiers
Chemin = "C:IMAGES"
'Boucle sur tous les fichiers du répertoire (photos).
Ligne = 3
Columns("K:K").ColumnWidth = 40 ' défini la largeur de la colonne
Columns("H:H").ClearContents
Columns("I:I").ClearContents
For Each Sh In ActiveSheet.Shapes
If Sh.Type = msoPicture Then 'msoPicture Then
Sh.Delete
End If
Next Sh
Fichier = Dir(Chemin & "*")
Do While Len(Fichier) > 0
'Extraction nom
splitArr = Split(Fichier, ".")
nom = splitArr(0)
Range("H" & Ligne).Value = CStr(nom)
Range("H" & Ligne).NumberFormat = "@"
Range("I" & Ligne) = "a" & Range("H" & Ligne) ''' pour corriger le bogue des noms numériques
'insertion de la photo dans la colonne K
Range("K" & Ligne).Select
'' Largeur = Range("K" & Ligne).Width
'' Hauteur = Range("K" & Ligne).Height
ActiveCell.RowHeight = 99 ' ajuste la hauteur de la ligne : 1 point = 0,035 cm
h = hDefaut
h = h - 4
ActiveSheet.Shapes.AddPicture(Chemin & Fichier, False, True, ActiveCell.Left, ActiveCell.Top, Largeur, Hauteur).Select
With Selection.ShapeRange
Rapport = h / Selection.Height
AjusterImage Selection, Rapport
.Name = Range("I" & Ligne)
End With
'Fichier suivant
Fichier = Dir()
Ligne = Ligne + 1
Loop
Range("H3").Select
With Worksheets("Pix")
DerLig = .Range("H" & Rows.Count).End(xlUp).Row
ActiveWorkbook.Names("PicTable").Delete
ActiveWorkbook.Names.Add Name:="PicTable", RefersTo:="=Pix!$H$2:$H$" & DerLig
End With
End Sub
Function AjusterImage(Imag As Object, Rapport As Single)
Dim Largeur As Single
Dim Hauteur As Single
Largeur = Imag.Width
Hauteur = Imag.Height
Largeur = Largeur * Rapport
Hauteur = Hauteur * Rapport
Imag.Width = Largeur
Imag.Height = Hauteur
End Function
performance vba excel image file-system
edited 2 hours ago
Jamal♦
30.3k11116227
asked yesterday
DLPDLP
111
New contributor
DLP is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
Check out our Code of Conduct.
$endgroup$
add a comment |
2
$begingroup$
Is there a way to make this code run faster? I have over 6000 pictures in .jpg optimized to a maximum of 40 kB. It starts quickly but after like 2000 pictures it runs way slower. The final .xlsm file is about 380 MB.
I'm using Excel 2016 with Windows 10 on a big server with 16 processors and 80 GiB RAM.
Sub Button5_Click()
With Excel.Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.DisplayStatusBar = False
.EnableEvents = False
End With
With Worksheets
DisplayPageBreaks = False
End With
ChargeTrombinoscope
With Excel.Application
.EnableEvents = True
.DisplayStatusBar = True
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
With Worksheets
DisplayPageBreaks = True
End With
''''CheckImageName
End Sub
Sub ChargeTrombinoscope()
Dim Chemin As String, Fichier As String
Dim nom, nom As String
Dim splitArr() As String
Dim Ligne As Integer
Dim Largeur As Integer
Dim Hauteur As Integer
Dim h As Long, Rapport As Single
Const hDefaut = 97
Worksheets("Pix").Activate
'Définit le répertoire contenant les fichiers
Chemin = "C:IMAGES"
'Boucle sur tous les fichiers du répertoire (photos).
Ligne = 3
Columns("K:K").ColumnWidth = 40 ' défini la largeur de la colonne
Columns("H:H").ClearContents
Columns("I:I").ClearContents
For Each Sh In ActiveSheet.Shapes
If Sh.Type = msoPicture Then 'msoPicture Then
Sh.Delete
End If
Next Sh
Fichier = Dir(Chemin & "*")
Do While Len(Fichier) > 0
'Extraction nom
splitArr = Split(Fichier, ".")
nom = splitArr(0)
Range("H" & Ligne).Value = CStr(nom)
Range("H" & Ligne).NumberFormat = "@"
Range("I" & Ligne) = "a" & Range("H" & Ligne) ''' pour corriger le bogue des noms numériques
'insertion de la photo dans la colonne K
Range("K" & Ligne).Select
'' Largeur = Range("K" & Ligne).Width
'' Hauteur = Range("K" & Ligne).Height
ActiveCell.RowHeight = 99 ' ajuste la hauteur de la ligne : 1 point = 0,035 cm
h = hDefaut
h = h - 4
ActiveSheet.Shapes.AddPicture(Chemin & Fichier, False, True, ActiveCell.Left, ActiveCell.Top, Largeur, Hauteur).Select
With Selection.ShapeRange
Rapport = h / Selection.Height
AjusterImage Selection, Rapport
.Name = Range("I" & Ligne)
End With
'Fichier suivant
Fichier = Dir()
Ligne = Ligne + 1
Loop
Range("H3").Select
With Worksheets("Pix")
DerLig = .Range("H" & Rows.Count).End(xlUp).Row
ActiveWorkbook.Names("PicTable").Delete
ActiveWorkbook.Names.Add Name:="PicTable", RefersTo:="=Pix!$H$2:$H$" & DerLig
End With
End Sub
Function AjusterImage(Imag As Object, Rapport As Single)
Dim Largeur As Single
Dim Hauteur As Single
Largeur = Imag.Width
Hauteur = Imag.Height
Largeur = Largeur * Rapport
Hauteur = Hauteur * Rapport
Imag.Width = Largeur
Imag.Height = Hauteur
End Function
performance vba excel image file-system
edited 2 hours ago
Jamal♦
30.3k11116227
asked yesterday
DLPDLP
111
New contributor
DLP is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
Check out our Code of Conduct.
$endgroup$
1
$begingroup$
how does it run with resizing disabled? If that makes it fast, you could prepare the catalog images with ImageMagick or another tool that is optimized for bulk image handling. If it's still too slow, try removing the call toAddPicture(). If that solves it, it may simply be that Excel is the wrong tool for this job.
$endgroup$
– Oh My Goodness
22 hours ago
add a comment |
2
2
2
1
$begingroup$
Is there a way to make this code run faster? I have over 6000 pictures in .jpg optimized to a maximum of 40 kB. It starts quickly but after like 2000 pictures it runs way slower. The final .xlsm file is about 380 MB.
I'm using Excel 2016 with Windows 10 on a big server with 16 processors and 80 GiB RAM.
Sub Button5_Click()
With Excel.Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.DisplayStatusBar = False
.EnableEvents = False
End With
With Worksheets
DisplayPageBreaks = False
End With
ChargeTrombinoscope
With Excel.Application
.EnableEvents = True
.DisplayStatusBar = True
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
With Worksheets
DisplayPageBreaks = True
End With
''''CheckImageName
End Sub
Sub ChargeTrombinoscope()
Dim Chemin As String, Fichier As String
Dim nom, nom As String
Dim splitArr() As String
Dim Ligne As Integer
Dim Largeur As Integer
Dim Hauteur As Integer
Dim h As Long, Rapport As Single
Const hDefaut = 97
Worksheets("Pix").Activate
'Définit le répertoire contenant les fichiers
Chemin = "C:IMAGES"
'Boucle sur tous les fichiers du répertoire (photos).
Ligne = 3
Columns("K:K").ColumnWidth = 40 ' défini la largeur de la colonne
Columns("H:H").ClearContents
Columns("I:I").ClearContents
For Each Sh In ActiveSheet.Shapes
If Sh.Type = msoPicture Then 'msoPicture Then
Sh.Delete
End If
Next Sh
Fichier = Dir(Chemin & "*")
Do While Len(Fichier) > 0
'Extraction nom
splitArr = Split(Fichier, ".")
nom = splitArr(0)
Range("H" & Ligne).Value = CStr(nom)
Range("H" & Ligne).NumberFormat = "@"
Range("I" & Ligne) = "a" & Range("H" & Ligne) ''' pour corriger le bogue des noms numériques
'insertion de la photo dans la colonne K
Range("K" & Ligne).Select
'' Largeur = Range("K" & Ligne).Width
'' Hauteur = Range("K" & Ligne).Height
ActiveCell.RowHeight = 99 ' ajuste la hauteur de la ligne : 1 point = 0,035 cm
h = hDefaut
h = h - 4
ActiveSheet.Shapes.AddPicture(Chemin & Fichier, False, True, ActiveCell.Left, ActiveCell.Top, Largeur, Hauteur).Select
With Selection.ShapeRange
Rapport = h / Selection.Height
AjusterImage Selection, Rapport
.Name = Range("I" & Ligne)
End With
'Fichier suivant
Fichier = Dir()
Ligne = Ligne + 1
Loop
Range("H3").Select
With Worksheets("Pix")
DerLig = .Range("H" & Rows.Count).End(xlUp).Row
ActiveWorkbook.Names("PicTable").Delete
ActiveWorkbook.Names.Add Name:="PicTable", RefersTo:="=Pix!$H$2:$H$" & DerLig
End With
End Sub
Function AjusterImage(Imag As Object, Rapport As Single)
Dim Largeur As Single
Dim Hauteur As Single
Largeur = Imag.Width
Hauteur = Imag.Height
Largeur = Largeur * Rapport
Hauteur = Hauteur * Rapport
Imag.Width = Largeur
Imag.Height = Hauteur
End Function
performance vba excel image file-system
edited 2 hours ago
Jamal♦
30.3k11116227
asked yesterday
DLPDLP
111
New contributor
DLP is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
Check out our Code of Conduct.
$endgroup$
Is there a way to make this code run faster? I have over 6000 pictures in .jpg optimized to a maximum of 40 kB. It starts quickly but after like 2000 pictures it runs way slower. The final .xlsm file is about 380 MB.
I'm using Excel 2016 with Windows 10 on a big server with 16 processors and 80 GiB RAM.
Sub Button5_Click()
With Excel.Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.DisplayStatusBar = False
.EnableEvents = False
End With
With Worksheets
DisplayPageBreaks = False
End With
ChargeTrombinoscope
With Excel.Application
.EnableEvents = True
.DisplayStatusBar = True
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
With Worksheets
DisplayPageBreaks = True
End With
''''CheckImageName
End Sub
Sub ChargeTrombinoscope()
Dim Chemin As String, Fichier As String
Dim nom, nom As String
Dim splitArr() As String
Dim Ligne As Integer
Dim Largeur As Integer
Dim Hauteur As Integer
Dim h As Long, Rapport As Single
Const hDefaut = 97
Worksheets("Pix").Activate
'Définit le répertoire contenant les fichiers
Chemin = "C:IMAGES"
'Boucle sur tous les fichiers du répertoire (photos).
Ligne = 3
Columns("K:K").ColumnWidth = 40 ' défini la largeur de la colonne
Columns("H:H").ClearContents
Columns("I:I").ClearContents
For Each Sh In ActiveSheet.Shapes
If Sh.Type = msoPicture Then 'msoPicture Then
Sh.Delete
End If
Next Sh
Fichier = Dir(Chemin & "*")
Do While Len(Fichier) > 0
'Extraction nom
splitArr = Split(Fichier, ".")
nom = splitArr(0)
Range("H" & Ligne).Value = CStr(nom)
Range("H" & Ligne).NumberFormat = "@"
Range("I" & Ligne) = "a" & Range("H" & Ligne) ''' pour corriger le bogue des noms numériques
'insertion de la photo dans la colonne K
Range("K" & Ligne).Select
'' Largeur = Range("K" & Ligne).Width
'' Hauteur = Range("K" & Ligne).Height
ActiveCell.RowHeight = 99 ' ajuste la hauteur de la ligne : 1 point = 0,035 cm
h = hDefaut
h = h - 4
ActiveSheet.Shapes.AddPicture(Chemin & Fichier, False, True, ActiveCell.Left, ActiveCell.Top, Largeur, Hauteur).Select
With Selection.ShapeRange
Rapport = h / Selection.Height
AjusterImage Selection, Rapport
.Name = Range("I" & Ligne)
End With
'Fichier suivant
Fichier = Dir()
Ligne = Ligne + 1
Loop
Range("H3").Select
With Worksheets("Pix")
DerLig = .Range("H" & Rows.Count).End(xlUp).Row
ActiveWorkbook.Names("PicTable").Delete
ActiveWorkbook.Names.Add Name:="PicTable", RefersTo:="=Pix!$H$2:$H$" & DerLig
End With
End Sub
Function AjusterImage(Imag As Object, Rapport As Single)
Dim Largeur As Single
Dim Hauteur As Single
Largeur = Imag.Width
Hauteur = Imag.Height
Largeur = Largeur * Rapport
Hauteur = Hauteur * Rapport
Imag.Width = Largeur
Imag.Height = Hauteur
End Function
performance vba excel image file-system
performance vba excel image file-system
edited 2 hours ago
Jamal♦
30.3k11116227
asked yesterday
DLPDLP
111
New contributor
DLP is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
Check out our Code of Conduct.
edited 2 hours ago
Jamal♦
30.3k11116227
asked yesterday
DLPDLP
111
New contributor
DLP is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
Check out our Code of Conduct.
edited 2 hours ago
Jamal♦
30.3k11116227
edited 2 hours ago
Jamal♦
30.3k11116227
edited 2 hours ago
Jamal♦
30.3k11116227
30.3k11116227
asked yesterday
DLPDLP
111
New contributor
DLP is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
Check out our Code of Conduct.
asked yesterday
DLPDLP
111
asked yesterday
DLPDLP
111
111
New contributor
DLP is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
Check out our Code of Conduct.
New contributor
DLP is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
Check out our Code of Conduct.
DLP is a new contributor to this site. Take care in asking for clarification, commenting, and answering.
Check out our Code of Conduct.
1
$begingroup$
how does it run with resizing disabled? If that makes it fast, you could prepare the catalog images with ImageMagick or another tool that is optimized for bulk image handling. If it's still too slow, try removing the call toAddPicture(). If that solves it, it may simply be that Excel is the wrong tool for this job.
$endgroup$
– Oh My Goodness
22 hours ago
add a comment |
1
$begingroup$
how does it run with resizing disabled? If that makes it fast, you could prepare the catalog images with ImageMagick or another tool that is optimized for bulk image handling. If it's still too slow, try removing the call toAddPicture(). If that solves it, it may simply be that Excel is the wrong tool for this job.
$endgroup$
– Oh My Goodness
22 hours ago
1
1
$begingroup$
how does it run with resizing disabled? If that makes it fast, you could prepare the catalog images with ImageMagick or another tool that is optimized for bulk image handling. If it's still too slow, try removing the call to
AddPicture(). If that solves it, it may simply be that Excel is the wrong tool for this job.$endgroup$
– Oh My Goodness
22 hours ago
$begingroup$
how does it run with resizing disabled? If that makes it fast, you could prepare the catalog images with ImageMagick or another tool that is optimized for bulk image handling. If it's still too slow, try removing the call to
AddPicture(). If that solves it, it may simply be that Excel is the wrong tool for this job.$endgroup$
– Oh My Goodness
22 hours ago
add a comment |
0
active
oldest
votes
Your Answer
StackExchange.ifUsing("editor", function () {
return StackExchange.using("mathjaxEditing", function () {
StackExchange.MarkdownEditor.creationCallbacks.add(function (editor, postfix) {
StackExchange.mathjaxEditing.prepareWmdForMathJax(editor, postfix, [["\$", "\$"]]);
});
});
}, "mathjax-editing");
StackExchange.ifUsing("editor", function () {
StackExchange.using("externalEditor", function () {
StackExchange.using("snippets", function () {
StackExchange.snippets.init();
});
});
}, "code-snippets");
StackExchange.ready(function() {
var channelOptions = {
tags: "".split(" "),
id: "196"
};
initTagRenderer("".split(" "), "".split(" "), channelOptions);
StackExchange.using("externalEditor", function() {
// Have to fire editor after snippets, if snippets enabled
if (StackExchange.settings.snippets.snippetsEnabled) {
StackExchange.using("snippets", function() {
createEditor();
});
}
else {
createEditor();
}
});
function createEditor() {
StackExchange.prepareEditor({
heartbeatType: 'answer',
autoActivateHeartbeat: false,
convertImagesToLinks: false,
noModals: true,
showLowRepImageUploadWarning: true,
reputationToPostImages: null,
bindNavPrevention: true,
postfix: "",
imageUploader: {
brandingHtml: "Powered by u003ca class="icon-imgur-white" href="https://imgur.com/"u003eu003c/au003e",
contentPolicyHtml: "User contributions licensed under u003ca href="https://creativecommons.org/licenses/by-sa/3.0/"u003ecc by-sa 3.0 with attribution requiredu003c/au003e u003ca href="https://stackoverflow.com/legal/content-policy"u003e(content policy)u003c/au003e",
allowUrls: true
},
onDemand: true,
discardSelector: ".discard-answer"
,immediatelyShowMarkdownHelp:true
});
}
});
DLP is a new contributor. Be nice, and check out our Code of Conduct.
draft saved
draft discarded
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
StackExchange.ready(
function () {
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fcodereview.stackexchange.com%2fquestions%2f212274%2fmaking-a-catalog-of-pictures%23new-answer', 'question_page');
}
);
Post as a guest
Required, but never shown
0
active
oldest
votes
0
active
oldest
votes
active
oldest
votes
active
oldest
votes
DLP is a new contributor. Be nice, and check out our Code of Conduct.
draft saved
draft discarded
DLP is a new contributor. Be nice, and check out our Code of Conduct.
DLP is a new contributor. Be nice, and check out our Code of Conduct.
DLP is a new contributor. Be nice, and check out our Code of Conduct.
Thanks for contributing an answer to Code Review Stack Exchange!
- Please be sure to answer the question. Provide details and share your research!
But avoid …
- Asking for help, clarification, or responding to other answers.
- Making statements based on opinion; back them up with references or personal experience.
Use MathJax to format equations. MathJax reference.
To learn more, see our tips on writing great answers.
draft saved
draft discarded
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
StackExchange.ready(
function () {
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fcodereview.stackexchange.com%2fquestions%2f212274%2fmaking-a-catalog-of-pictures%23new-answer', 'question_page');
}
);
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
1
$begingroup$
how does it run with resizing disabled? If that makes it fast, you could prepare the catalog images with ImageMagick or another tool that is optimized for bulk image handling. If it's still too slow, try removing the call to
AddPicture(). If that solves it, it may simply be that Excel is the wrong tool for this job.$endgroup$
– Oh My Goodness
22 hours ago