excel - VBA在单元格中添加图像给出不同的结果

标签 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" & 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

关于excel - VBA在单元格中添加图像给出不同的结果,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/67488304/

相关文章:

python - 如何在 python 中分块读取大图像?

excel - 在 Excel 中对文本字符串使用 if 和 A​​ND 的组合

vba - 在vba中循环具有特定功能的工作表

vba - Excel VBA 阻止我粘贴值

vba - 将多张工作表保存为 PDF

vba - 声明字符串变量时需要对象错误

.net - 在没有安装office的情况下在.net中创建excel文件

excel - 使用来自固定列引用但来自当前事件行的内容动态更新单个单元格

android - React Native Image 不显示,我该如何解决?

html - 替代 HTTP 客户端提示