0

Excelワークシートに画像を挿入しようとしています。

コードは次のとおりです。

Function AddImage(path As String, filename As String)
    Dim file As String
    file = path + "/" + filename + ".png"

    ActiveSheet.Range("A1").Pictures.insert(file).Select
End Function

しかし、これは機能しません。時計をオンfileにすると、ハード ドライブ上のイメージへの有効なパスが含まれていることがわかります。

セルに画像を入力するにはどうすればよいですか?

4

3 に答える 3

3

写真をセルの「中に」入れることはできず、「上に」入れるだけです。すべての画像がワークシート上に「浮かびます」。画像の Top および Left プロパティをセルの Top および Left に設定することにより、画像をセル上に配置できます。

Sub AddPicOverCell(path As String, filename As String, rngRangeForPicture As Range)
With Application
Dim StartingScreenUpdateing As Boolean
Dim StartingEnabledEvent As Boolean
Dim StartingCalculations As XlCalculation

StartingScreenUpdateing = .ScreenUpdating
StartingEnabledEvent = .EnableEvents
StartingCalculations = .Calculation

    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With

Dim Top As Single, Left As Single, Height As Single, Width As Single
Dim file As String
Dim ws As Worksheet

file = path + "/" + filename + ".png"

Top = rngRangeForPicture.Top
Left = rngRangeForPicture.Left
Height = rngRangeForPicture.Height
Width = rngRangeForPicture.Width

Set ws = rngRangeForPicture.Worksheet

ws.Shapes.AddPicture file, msoCTrue, msoTrue, Left, Top, Width, Height

With Application
    .ScreenUpdating = StartingScreenUpdateing
    .EnableEvents = StartingEnabledEvent
    .Calculation = StartingCalculations
End With
End Sub

そして、次のように呼び出します。

AddPicOverCell "C:\", "Pic", ActiveSheet.Range("A1")

注：これにより、サブを呼び出すときに指定したセルと同じサイズとシート上の位置に画像が配置され、サイズが変更されます。これにより、画像を挿入するセルまたは範囲に画像が挿入されます。これは、セルの範囲B5:G25または私の例のように単一のセルのようRange("A1")に、画像が範囲内のすべてのセルをカバーする場合もあります。

于 2013-10-18T13:38:45.553 に答える
1

はい、セルに画像を追加できます。少なくとも私にとっては機能します。

Sub testInsertAndDeletePicInCell()

Dim rng_PicCell         As Range
Dim thisPic             As Picture

Const MaxH = 50
Const MaxW = 14


    ' INSERT a picture into a cell

    ' assign cell to range
    Set rng_PicCell = ActiveSheet.Cells(2, 2) ' cell B2

    ' modify the range
    With rng_PicCell
        .RowHeight = MaxH
        .ColumnWidth = MaxW

        ' insert the picture
        Set thisPic = .Parent.Pictures.Insert("C:\tmp\mypic.jpg")

        ' format so the picture fits the cell frame
        thisPic.Top = .Top + 1
        thisPic.Left = .Left + 1
        thisPic.Width = .Width - 2
        thisPic.Height = .Height - 2

    End With


    Stop

    ' DELETE a picture
    thisPic.Parent.Pictures.Delete

End Sub
于 2015-03-27T15:16:14.147 に答える
0

FunctionではなくSubが必要です。

編集＃1：

パスとファイル名が正しいことを確認してください。これは私のために働く例です：

Sub qwerty()
    Dim p As Picture
    Dim sPath As String, sFileName As String, s As String
    sPath = "F:\Pics\Wallpapers\"
    sFileName = "mercury.jpg"
    s = sPath & sFileName
    Set p = ActiveSheet.Pictures.Insert(s)
End Sub
于 2013-10-18T13:18:06.040 に答える