Excel VBA“在单元格中添加图像”会给出不同的结果
我有一个关于一个我似乎无法解决的问题的问题。 我有一些VBA代码,其中包括单元格中的图片:Excel VBA“在单元格中添加图像”会给出不同的结果,excel,vba,image,Excel,Vba,Image,我有一个关于一个我似乎无法解决的问题的问题。 我有一些VBA代码,其中包括单元格中的图片: fNameAndPath = UserForm1.ComboBox2.Value Set img = Application.ActiveSheet.Shapes.AddPicture(fNameAndPath, False, True, 1, 1, 1, 1) With img .Left = ActiveSheet.Range("G" &
fNameAndPath = UserForm1.ComboBox2.Value
Set img = Application.ActiveSheet.Shapes.AddPicture(fNameAndPath, False, True, 1, 1, 1, 1)
With img
.Left = ActiveSheet.Range("G" & Lastrow).Left
.Top = ActiveSheet.Range("G" & Lastrow).Top
.Width = ActiveSheet.Range("G" & Lastrow).Width
.Height = ActiveSheet.Range("G" & Lastrow).Height
.Placement = 1
End With
这段代码非常适合我自己。这些画插得很漂亮。
然而,使用宏的同事中有20%的人在H列而不是G列中找到他们的图片
我想不出发生这种情况的原因。
遇到相关问题的人
感谢您很抱歉耽搁了您的时间,在此,我们将介绍此宏中的全部代码
Sub CommandButton3_Click()
‘ check whether conditions are OK
If UserForm1.TextBox1.Value = "" Or UserForm1.TextBox2.Value = "" Or UserForm1.TextBox3.Value = "" Or UserForm1.ComboBox1.Value = "" Then
MsgBox ("")
Exit Sub
End If
‘Check whether a picture was attached
If UserForm1.ComboBox2.Value = "" Then
MsgBox ("")
Exit Sub
End If
Workbooks("").Sheets("").Unprotect ""
‘Find username of the user
Dim username As String
username = Environ("username")
‘define lastrow and write some data in the cells
Lastrow = Worksheets("Objets Inutiles").Range("A650000").End(xlUp).Row + 1
Worksheets("Objets Inutiles").Range("A" & Lastrow).Value = "=Now()"
Worksheets("Objets Inutiles").Range("A" & Lastrow).Select
Selection.Copy
Worksheets("Objets Inutiles").Range("A" & Lastrow).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("Objets Inutiles").Range("B" & Lastrow).Value = ""
Worksheets("Objets Inutiles").Range("C" & Lastrow).Value = username
Worksheets("Objets Inutiles").Range("C" & Lastrow).Select
Selection.Copy
Worksheets("Objets Inutiles").Range("C" & Lastrow).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets("Objets Inutiles").Range("D" & Lastrow).Value = UserForm1.ComboBox1.Value
Worksheets("Objets Inutiles").Range("E" & Lastrow).Value = UserForm1.TextBox2.Value
Worksheets("Objets Inutiles").Range("F" & Lastrow).Value = UserForm1.TextBox3.Value
Worksheets("Objets Inutiles").Range("H" & Lastrow).Value = UserForm1.TextBox1.Value
Worksheets("Objets Inutiles").Range("I" & Lastrow).Value = ""
Worksheets("Objets Inutiles").Range("J" & Lastrow).Value = ""
fNameAndPath = UserForm1.ComboBox2.Value
Set img = Application.ActiveSheet.Shapes.AddPicture(fNameAndPath, False, True, 1, 1, 1, 1)
With img
'Resize Picture to fit in the range....
.Left = ActiveSheet.Range("G" & Lastrow).Left
.Top = ActiveSheet.Range("G" & Lastrow).Top
.Width = ActiveSheet.Range("G" & Lastrow).Width
.Height = ActiveSheet.Range("G" & Lastrow).Height
.Placement = 1
End With
‘send some spam around
Dim EmailApp As Outlook.Application
Dim Source As String
Set EmailApp = New Outlook.Application
Dim EmailItem As Outlook.MailItem
Set EmailItem = EmailApp.CreateItem(olMailItem)
EmailItem.To = ""
EmailItem.CC = ""
EmailItem.BCC = ""
EmailItem.Subject = ""
EmailItem.HTMLBody = ""
EmailItem.Send
Unload UserForm1
Workbooks("").Sheets("").Protect ""
Workbooks("").Save
MsgBox ("")
Exit Sub
Unload Me
Workbooks("").Sheets("").Protect "Sapore"
Workbooks("").Save
MsgBox ("")
End Sub
他们是否将工作表窗口缩放设置为100%以外的任何值?我会将
ActiveSheet
保存到局部变量Dim sht作为工作表:设置sht=ActiveSheet
,然后改用该变量。在宏运行时,可能会更改活动工作表,因此最好始终针对此类边缘情况进行保护。您不想阅读另一张工作表的G列中的.Left
属性我一生都无法复制此问题-我尝试过各种缩放等,但它们最终都完美就位(就像对您一样!)。是否有任何其他代码(未包含在示例中)在此之后运行,可能会插入/删除列?