0
VBAを使用して画像を挿入しようとしていますが、コードは画像をExcelシートにのみリンクします。画像を削除すると、シート内のリンクされた画像が削除されます。リンクされた画像をブックに保存するようにコードを調整する必要があります。この私がvbaで画像を挿入
Sub DeleteImages()
For Each s In ActiveSheet.Shapes
s.Delete
Next s
ActiveSheet.Cells.Rows.AutoFit
End Sub
Sub AddImages()
Dim sImgFile As String
sPath = ActiveWorkbook.Path & Application.PathSeparator
Set ws = ActiveSheet
ltop = Val(InputBox("Provide height", "Height"))
'lwid = Val(InputBox("Provide width", "Width"))
'On Error GoTo StopIt
If ltop > 0 Then 'And lwid > 0
ws.Range("E1").ColumnWidth = 1
For l = 2 To ws.Range("A" & Rows.Count).End(xlUp).Row
ws.Range("A" & l).Rows.AutoFit
sImgFile = Dir(sPath & ws.Range("B" & l).Value & ".*")
If sImgFile <> "" Then
With ws.Pictures.Insert(sPath & sImgFile)
With .ShapeRange
.LockAspectRatio = msoTrue
'.Width = lwid
.Height = ltop
i = 1
ws.Range("E" & l).ColumnWidth = Application.WorksheetFunction.Max(.Width/5.3, ws.Range("E" & l).ColumnWidth)
ws.Range("E" & l).RowHeight = .Height + 4
End With
.Left = ws.Cells(l, 5).Left
.Top = ws.Cells(l, 5).Top + 2
.Placement = 1
.PrintObject = True
Call Macro1(Range("E" & l))
End With
End If
Next l
End If
For Each s In ActiveSheet.Shapes
s.Left = ws.Range("E1").Left + (ws.Range("E1").Width - s.Width)/2
Next s
StopIt:
On Error GoTo 0
End Sub
はシェイプとして画像を追加できませんでした何らかの理由はありますか? –
私はこのコードを試してみました:もしsImgFile <> "" 次にws.Shapes.AddPictureで (SPATH&sImgFile、linktofile:= msoFalse、_ savewithdocument:= msoCTrue).ShapeRange .LockAspectRatio = msoTrue 」で .Width = lwid .Height = ltop w = Range( "E"&l).ColumnWidth = ws.Range( "E" &L).RowHeight = .Height + 4 – paul
それは[得意埋め込ま画像を挿入するVBA]の誤差 – paul