Question

我有一个包含电子表格的文件夹。除了此电子表格（在包含电子表格的同一文件夹中）之外，还有一个名为“images”的文件夹。此文件夹可能包含0到10,000个图像，作为单独的png文件。

文件的名称如下：

00001.png

...

00010.png

...

00100.png

...

01000.png

...

10000.png

（其中“...”表示多个文件之间的间隙，请记住文件以1为增量增加，例如：00001.png后面紧跟00002.png）。

我要求前面提到的电子表格（包含在与“images”文件夹相同的文件夹中，但不在“images”文件夹本身内）能够通过，但是这些图像中的许多图像碰巧存在于10,000长细胞范围'C3：C10002'（C3至C10002）。

只有在存在的情况下才能通过图像，如果不存在，则电子表格/ VBA宏/脚本不应该崩溃而不利于用户。

这极有可能需要某种Excel VBA宏，可以通过按下按钮来运行（我知道如何插入宏按钮）。

脚本不应改变图像的大小/尺寸。包含细胞的宽度和高度应调整到完美适合图像。

据我所知，Excel单元格具有最大高度/宽度，并且必须对图像进行预优化以适合单元格。我希望图像显示为大约3英寸宽，1.6英寸高的缩略图（不确定像素是什么！）

我非常感谢任何帮助......即使你不能提出能够完成所有这些目标的事情，也会热烈欢迎“最好的镜头”。

Answer 1

我有这个代码可以帮助将图像添加到工作表中，您可以将其修改为在多个文件中循环并根据文件名添加图像文件：

Sub AddPictures()
    DirForImages = "S:\TCarnevale\Overdrive Images\"
    Dim counter As Integer
    Dim vsn As Boolean
    Dim myrange As Range


            ActiveSheet.Pictures.Delete
            Range("Y15").Select
            For I = 0 To 400

                DoEvents

                'Set picture range depending on count, *modify below set of code to add/remove styles*


                    Set Rng = Range("A8")


                    'get the style number to pull the image from the directory
                        styleinfo = ActiveCell.Value

                        If Dir(DirForImages & styleinfo & ".jpg") <> "" Then
                            Set pic = ActiveSheet.Shapes.AddPicture(DirForImages & styleinfo & ".jpg", False, True, 1, 1, 1, 1)
                            'resize the image
                            With pic
                                .Height = 100
                                .Width = 75
                                .Left = Rng.Left
                                .Top = Rng.Top

                            End With



                            counter = counter + 1
                        ElseIf Dir(DirForImages & styleinfo & ".png") <> "" Then
                            Set pic = ActiveSheet.Shapes.AddPicture(DirForImages & styleinfo & ".png", False, True, 1, 1, 1, 1)
                            'resize the image
                            With pic
                                .Height = 100
                                .Width = 75
                                .Left = Rng.Left
                                .Top = Rng.Top

'
                            End With



                            counter = counter + 1
                        Else


                            counter = counter + 1
                        End If



                    ActiveCell.Offset(1, 0).Select

            Next
            Range("Y17").Select


Range("A1").Select


End Sub

此代码检查PNG文件以及JPG文件，并以像素为单位调整大小。您可以使用this calculator将英寸转换为像素。

Answer 2

我不会按照你期望的方式看待它。

首先，尝试在电子表格中显示10,000个PNG文件让我感到非常糟糕。内存要求可能会轻易锁定您的计算机或使Excel崩溃。

其次，VBA中的设置单元大小可能会令人困惑。默认情况下，单元格高度以磅为单位指定，而宽度则根据默认字体进行测量。

https://support.office.com/en-ca/article/Change-the-column-width-and-row-height-72f5e3cc-994d-43e8-ae58-9774a0905f46

第三，您需要具有正确尺寸和ppi / dpi分辨率的图像。 Excel尊重打印尺寸，因此96ppi的300像素图像与150ppi的300像素图像的显示方式不同。

第四，显示器不像纸张尺寸那样以英寸为单位进行测量。现代显示器具有多种分辨率，从低端的72dpi到一些移动设备和Retina / HiDPI屏幕的300dpi以上。这将影响图片的大屏幕外观。

说完了所有这些：

我会在像Photoshop这样的程序中批量处理图像，以300像素宽，96ppi为其设置它们（根据需要）。

我不会尝试在电子表格中显示10,000张图片。将其分成几个文件。

最后，一些快速拼凑的代码可能是一个起点：

Dim InsertLoc As Range
Dim i As Integer
Dim PName As String
Sub Macro1()
i = 2
PName = ""
Columns("A:A").ColumnWidth = 43
Application.ScreenUpdating = False
For i = 1 To 10
Set InsertLoc = Range("A" & CStr(i))
InsertLoc.Select
PName = "C:\Users\user\Desktop\" & i & ".jpg"
Rows(i).RowHeight = 150
On Error Resume Next
 ActiveSheet.Pictures.Insert PName
 Next i
 Application.ScreenUpdating = True
End Sub

Excel 2010：将文件夹中包含的图像拉入Excel单元格

2 个答案: