$image_filenames[$count++]
##
Option Explicit
Const ksFactor As Double = 0.177346958265686
Const knMaxWidth As Long = 100
Sub Main()
Dim pic As Picture
For Each pic In Sheet1.Pictures
pic.Delete
Next pic
Sheet1.UsedRange.Clear
Dim row As Long
Dim col As Long
Dim dirName As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Choose a directory"
.Show
If .SelectedItems.Count = 0 Then End
dirName = .SelectedItems(1)
End With
Dim nFile As Long
Dim sFile As String
Dim sFiles() As String
sFile = Dir(dirName & "\*.jpg")
Do While Len(sFile) > 0
nFile = nFile + 1
ReDim Preserve sFiles(1 To nFile)
sFiles(nFile) = sFile
sFile = Dir
Loop
Dim nWidth As Long
Dim nHeight As Long
nWidth = Int(Sqr(nFile))
nHeight = Int(nFile / nWidth)
If nWidth * nHeight < nFile Then nHeight = nHeight + 1
Dim nCount As Long
nCount = 0
For row = 1 To nHeight
Dim nMaxHeight As Long
nMaxHeight = 0
For col = 1 To nWidth
If nCount < nFile Then
nCount = nCount + 1
Dim picCurrent As Picture
Set picCurrent = Sheet1.Pictures.Insert(sFiles(nCount))
picCurrent.Top = Sheet1.Cells(row, col).Top
picCurrent.Left = Sheet1.Cells(row, col).Left
Dim nPicWidth As Double
Dim nPicHeight As Double
nPicWidth = picCurrent.Width
nPicHeight = picCurrent.Height
If nPicWidth > knMaxWidth Then
picCurrent.Width = knMaxWidth
picCurrent.Height = knMaxWidth / nPicWidth * nPicHeight
End If
nMaxHeight = Application.Max(picCurrent.Height, nMaxHeight)
Sheet1.Cells(row, col).Value = sFiles(nCount)
If row = 1 _
Or Sheet1.Columns(col).ColumnWidth < picCurrent.Width * ksFactor Then
Sheet1.Columns(col).ColumnWidth = picCurrent.Width * ksFactor
End If
End If
Next col
Sheet1.Rows(row).RowHeight = nMaxHeight + 11.75
Next row
For col = 1 To nWidth
Sheet1.Columns(col).ColumnWidth = Sheet1.Columns(col).ColumnWidth + 1
Next col
End Sub
####
use strict;
use warnings;
use Win32::OLE;
use File::Spec;
my $ksFactor = 0.177346958265686;
my $knMaxWidth = 100;
my $xl = Win32::OLE->new('Excel.Application');
$xl->{EnableEvents} = 0;
$xl->{ScreenUpdating} = 1;
$xl->{Visible} = 1;
my $wb = $xl->Workbooks->Add;
my $sht = $wb->Sheets(1);
my $dialogue = $xl->FileDialog(4); #msoFileDialogFolderPicker = 4
$dialogue->{Title} = "Choose a directory";
$dialogue->Show;
if ($dialogue->SelectedItems->Count == 0) {die "No directory selected";}
my $dirName = $dialogue->SelectedItems(1);
my $filemask = File::Spec->catfile($dirName, '*.jpg');
my @sFiles = sort(glob($filemask));
my $nWidth = int(sqrt(scalar @sFiles)) - 1;
my $nHeight = int(scalar @sFiles / $nWidth);
if ($nWidth * $nHeight < scalar @sFiles) {$nHeight++};
my $nCount = 0;
for my $row (1..$nHeight) {
my $nMaxHeight = 0;
for my $col (1..$nWidth) {
if ($nCount < scalar @sFiles) {
my $picCurrent = $sht->Pictures->Insert($sFiles[$nCount]);
$picCurrent->{Top} = $sht->Cells($row, $col)->{Top};
$picCurrent->{Left} = $sht->Cells($row, $col)->{Left};
my $nPicWidth = $picCurrent->{Width};
my $nPicHeight = $picCurrent->{Height};
if ($nPicWidth > $knMaxWidth) {
$picCurrent->{Width} = $knMaxWidth;
$picCurrent->{Height} = $knMaxWidth / $nPicWidth * $nPicHeight;
}
$nMaxHeight = $xl->Max($picCurrent->{Height}, $nMaxHeight);
my ($vol, $path, $file) = File::Spec->splitpath($sFiles[$nCount]);
$sht->Cells($row, $col)->{Value} = $file;
if ($row == 1
|| $sht->Columns($col)->{ColumnWidth} < $picCurrent->{Width} * $ksFactor) {
$sht->Columns($col)->{ColumnWidth} = $picCurrent->{Width} * $ksFactor;
}
$nCount++;
}
}
$sht->Rows($row)->{RowHeight} = $nMaxHeight + 11.75;
}
for my $col (1..$nWidth) {
$sht->Columns($col)->{ColumnWidth}++;
}
my ($vol, $path, $file) = File::Spec->splitpath($sFiles[0]);
my $setup = $sht->PageSetup;
$setup->{LeftHeader} = $vol . $path;
$setup->{Orientation} = 1; #xlPortrait
$setup->{Zoom} = 0; #False
$setup->{FitToPagesWide} = 1;
$setup->{FitToPagesTall} = 1;
####
#!perl
use strict;
use warnings;
use diagnostics;
use File::Spec;
use GD;
# Edit only these five values
my $WIDTHmm = 201; # printable area width in mm
my $HEIGHTmm = 288; # printable area height in mm
my $BORDERmm = 5; # white space between photos in mm
my $FONTmm = 3; # font height in mm
my $DPI = 96; # dots per inch
# Remaining variables derived from the above
my $DPmm = $DPI/25.4; # dots per mm
my $WIDTH = $WIDTHmm * $DPmm;
my $HEIGHT = $HEIGHTmm * $DPmm;
my $BORDER = $BORDERmm * $DPmm;
my $POINTS = $DPmm * $FONTmm;
my $TEXTHEIGHT = $POINTS;
print "$POINTS points\n";
my $dir = shift || ".";
my $filemask = File::Spec->catfile( $dir, '*.jpg' );
my @image_filenames = sort(glob($filemask)); # sort just to be sure...
# Dimension an almost square rectangle
my $cols = int( sqrt(scalar @image_filenames) );
my $rows = (scalar @image_filenames) / $cols;
if ( $rows != int($rows) ) { $rows = int($rows) + 1; }
# Calculate the cell size in pixels
# totalwidth = cols * cellwidth + ( cols - 1 ) * border
# (totalwidth - ( cols - 1 ) * border) / cols = cellwidth
my $cellWidth = ($WIDTH - ($cols - 1) * $BORDER ) / $cols;
my $cellHeight = ($HEIGHT / $rows) - $BORDER;
my $img = new GD::Image($WIDTH, $HEIGHT);
$img->transparent($img->colorAllocate(255,255,255));
my $black = $img->colorAllocate(0,0,0);
my ($row, $col) = (0,0);
for my $imgname (@image_filenames) {
my $imgsrc = GD::Image->newFromJpeg($imgname);
my ($widthsrc,$heightsrc) = $imgsrc->getBounds();
# Scale the image, preserving the aspect ratio
my $scalefactor = $cellWidth / $widthsrc;
if ( $cellHeight / $heightsrc < $scalefactor ) { $scalefactor = $cellHeight / $heightsrc; }
my $dstX = $col * ($cellWidth + $BORDER);
my $dstY = $row * ($cellHeight + $BORDER);
my $destW = $scalefactor * $widthsrc;
my $destH = $scalefactor * $heightsrc;
$img->copyResampled($imgsrc, $dstX, $dstY, 0, 0, $destW, $destH, $widthsrc, $heightsrc);
my ($vol, $path, $file) = File::Spec->splitpath($imgname);
my @ret = $img->stringFT($black,$ENV{'windir'}."\\Fonts\\arial.ttf",$POINTS,0,$dstX,$dstY+$destH+$TEXTHEIGHT,$file);
unless ( @ret ) { print $@; }
if (++$col >= $cols) { $col=0; ++$row; } # next picture position
}
open(my $fh, ">", "$dir\\Thumbs.png") or die "Couldn't open output file.";
binmode $fh;
print $fh $img->png;
close $fh;