如何手动select在哪里插入一个值/图片
我正在寻找的是VBAmacros中的一种方式，有一个设置，所以在我的单元格被激活（在表中的任何地方），macros将插入一个特定的值或图片的地方。
这样做有什么办法吗？
我只是知道如何在macros指定一个范围的图片应插入，但我希望它插入我手动通过鼠标select的地方。 我的VBA代码：
Sub Importera_bilder() Dim mainWorkBook As Workbook Dim sh As Worksheet Dim ws2 As Worksheet Dim ws As Worksheet Dim sh2 As Worksheet Set sh = Sheets("Kundinformation") Set ws2 = Sheets("Partner_information") Set ws = Sheets("Kalkyl") Set sh2 = Sheets("Start") Set mainWorkBook = ActiveWorkbook Sheets("Projektunderlag").Activate FolderPath = ws2.Range("B21").Value Set fso = CreateObject("Scripting.FileSystemObject") NoOfFiles = fso.GetFolder(FolderPath).Files.Count Set listfiles = fso.GetFolder(FolderPath).Files For Each fls In listfiles strCompFilePath = FolderPath & "\" & Trim(fls.Name) If strCompFilePath <> "" Then If (InStr(1, strCompFilePath, "jpg", vbTextCompare) > 1 _ Or InStr(1, strCompFilePath, "jpeg", vbTextCompare) > 1 _ Or InStr(1, strCompFilePath, "png", vbTextCompare) > 1) Then counter = counter + 1 'Sheets("Object").Range("A" & counter).Value = fls.Name 'Sheets("Projektunderlag").Range("M" & counter).ColumnWidth = 10 'Sheets("Projektunderlag").Range("M" & counter).RowHeight = 13 'Sheets("Projektunderlag").Range("M" & counter).Activate Call insert(strCompFilePath, counter) Sheets("Projektunderlag").Activate End If End If Next mainWorkBook.Save End Sub Function insert(PicPath, counter) 'MsgBox PicPath With ActiveSheet.Pictures.insert(PicPath) With .ShapeRange .LockAspectRatio = msoTrue .Width = 270 .Height = 230 End With ActiveSheet.Range("M269").Select .Left = ActiveSheet.Range("M269").Left .Top = ActiveSheet.Range("M269").Top .Placement = 1 .PrintObject = True End With End Function 你想使用ActiveCell属性。
例如，如果我想在单元格中放置数字900，我select了我的VBA：
Sub Insert900() ActiveCell.Value = 900 End Sub
在Sub Importera_bilder()包含/更改
.... Dim PicNail as Range ' this is where we nail the pic to Set PicNail = Selection ' current cell cusrsor position .... Call insert(strCompFilePath, counter, PicNail)
和插入function变成…
Function insert(PicPath, counter, NailTo As Range) 'MsgBox PicPath With ActiveSheet.Pictures.Insert(PicPath) With .ShapeRange .LockAspectRatio = msoTrue .Width = 270 .Height = 230 ' don't do both! End With .Left = NailTo.Left .Top = NailTo.Top .Placement = 1 .PrintObject = True End With End Function
注意：
当你把AspectRatiolocking的时候，没有必要改变宽度和高度，因为当你设置另外一个时，任何一个都会自动调整（这就是宽高比）
当您想要将图像放入270W x 230H的盒子中时，您需要设置较大的尺寸（以较高者为准），并保留宽高比。
进一步阅读：
VBA Excel 2010 – embedded图片和resize
OLEObject高度和宽度不一致
另外请注意，在Excel 2010中的Picture.Insert方法行为不同于以前…它是insertin ga LINKED对象，所以你可能想包括分配给LinkToFile和SaveWithDocument或更改代码为ActiveSheet.Shapes.AddPicture(...)