添加圖像作爲評論VBA

-1

我發現此代碼插入圖像到Excel 2013中，但圖像比他們要進入的單元格大。我認爲它是加載圖像作爲評論的最佳選擇。添加圖像作爲評論VBA

有人可以修改下面這個VBA以添加此評論？

Sub URLPictureInsert() 
Dim cell, shp As Shape, target As Range 
    Set rng = ActiveSheet.Range("R2:R5") ' range with URLs 
    For Each cell In rng 
     filenam = cell 
     ActiveSheet.Pictures.Insert(filenam).Select 

    Set shp = Selection.ShapeRange.Item(1) 
    With shp 
     .LockAspectRatio = msoTrue 
     .Width = 50 
     .Height = 50 
     .Cut 
    End With 
    Cells(cell.Row, cell.Column + 5).PasteSpecial 

Next 

End Sub

來源

2014-01-28 Makdaddy

@ChrisB [不是我的答案，但DeanBDean的（https://stackoverflow.com/a/21397899） –

從您的評論響應由@DeanBDean答案我知道你要嵌入的圖像 - 從一個網址 - 進入評論。你應該修改你的問題來解釋這一點。 – ChrisB

我相信下面的鏈接有您正在尋找

http://en.kioskea.net/faq/8619-excel-a-macro-to-automatically-insert-image-in-a-comment-box

Sub Img_in_Commentbox() 
With Application.FileDialog(msoFileDialogFilePicker) 
     .AllowMultiSelect = False   'Only one file 
     .InitialFileName = CurDir   'directory to open the window 
     .Filters.Clear     'Cancel the filter 
     .Filters.Add Description:="Images", Extensions:="*.jpg", Position:=1 
     .Title = "Choose image" 

     If .Show = -1 Then TheFile = .SelectedItems(1) Else TheFile = 0 
    End With 
'No file selected 
If TheFile = 0 Then 
MsgBox ("No image selected") 
Exit Sub 
End If 
Range("A1").AddComment 
    Range("A1").Comment.Visible = True 
[A1].Comment.Shape.Fill.UserPicture TheFile 
End Sub

來源

2014-01-28 05:51:40 DeanBDean

謝謝，但沒有問我要添加圖像。我有R2的網址：R5我需要他們嵌入評論。但我感謝你回來嘗試 – Makdaddy

什麼？如果你希望你的圖片到你的目標單元格高度尺寸使用匹配：

With shp 
    .LockAspectRatio = msoTrue 
    '.Width = Cells(cell.Row, cell.Column + 5).Width 'Uncomment this line and comment out .Height line to match cell width 
    .Height = Cells(cell.Row, cell.Column + 5).Height 
    .Cut 
End With

如果你想匹配兩個單元格和高度使用：

With shp 
    .LockAspectRatio = msoFalse 
    .Width = Cells(cell.Row, cell.Column + 5).Width 
    .Height = Cells(cell.Row, cell.Column + 5).Height 
    .Cut 
End With

來源

2014-01-28 07:41:15 hstay

完美謝謝。我是否必須爲這個下一個問題開始新的研究？我的行不同，從文檔到文檔我如何獲得此代碼適用於ROW R中有URL的所有行。**設置rng = ActiveSheet.Range（「R2：R5」）'範圍與URL ** – Makdaddy

'Set Rng = ActiveSheet.Range（「R2：」＆ActiveSheet.Range（「R」＆ActiveSheet.Rows.Count）.End（xlUp）.Address）'將選擇你的範圍，不管你填充了多少行。然後，如果你想檢查有效的URL，你需要一些模式，例如在「.jpg」中完成，你可以使用If If（cell.value，4）=「。jpg」來檢查這些文件。然後'其餘代碼' – hstay

我更新了上面的代碼，並且還從列「B」（第2列）獲取圖像的路徑。我點擊單元格上的宏：

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
Dim listWS As Worksheet 
Dim targetCol, targetRow As Long 
Dim TheFile As String 

Set listWS = Application.ThisWorkbook.Sheets("Catalogue") 
    If Target.Column = 2 Then 
     targetCol = Target.Column 
     targetRow = Target.Row 
     TheFile = listWS.Cells(targetRow, targetCol).Value 
     With listWS.Range(listWS.Cells(targetRow, 4), listWS.Cells(targetRow, 4)) 
      .AddComment 
      .Comment.Visible = True 
      .Comment.Shape.Fill.UserPicture TheFile 
     End With 
    End If 
End Sub

來源

2014-09-03 08:43:43 Andrew

這會在您單擊的單元格上快速添加圖片作爲註釋。它也調整到我喜歡的項目，我正在做。

With Application.FileDialog(msoFileDialogFilePicker) 
    .AllowMultiSelect = False   'Only one file 
    .InitialFileName = CurDir   'directory to open the window 
    .Filters.Clear     'Cancel the filter 
    .Filters.Add Description:="Images", Extensions:="*.png", Position:=1 
    .Title = "Choose image" 

    If .Show = -1 Then TheFile = .SelectedItems(1) Else TheFile = 0 
End With 
'No file selected 
If TheFile = 0 Then 
MsgBox ("No image selected") 
Exit Sub 
End If 
Selection.AddComment 
Selection.Comment.Visible = True 
Selection.Comment.Shape.Fill.UserPicture TheFile 
Selection.Comment.Shape.Select True 
Selection.ShapeRange.ScaleWidth 2.6, msoFalse, msoScaleFromTopLeft 
Selection.ShapeRange.ScaleHeight 2.8, msoFalse, msoScaleFromTopLeft 
ActiveCell.Comment.Visible = False

來源

2016-01-21 18:51:24 Cody

添加圖像作爲評論VBA

回答

相關問題