Excel VBA构建宾果卡与图片,而不是数字(Excel VBA to build bingo cards with pictures instead of numbers)

Office IT屋
问 题

Edit - The current code I am working with is below:

Dim i As Integer
Dim sFilename As String
Dim bcontinue As Boolean
Dim spath As String

Sub Attempt1()
On Error Resume Next


spath = "location"

i = 2

bcontinue = True

While bcontinue
sFilename = Worksheets(1).Cells(i, 1).Value
If sFilename = "" Then
bcontinue = False
Else

Cells(i, 7).Select
ActiveSheet.Pictures.Insert(spath + sFilename + ".jpg").Select
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 50
Selection.ShapeRange.Width = 50
i = i + 1
End If
Wend

On Error Resume Next


spath = "location"

i = 2

bcontinue = True

While bcontinue
sFilename = Worksheets(1).Cells(i, 2).Value
If sFilename = "" Then
bcontinue = False
Else

Cells(i, 8).Select
ActiveSheet.Pictures.Insert(spath + sFilename + ".jpg").Select
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 50
Selection.ShapeRange.Width = 50
i = i + 1
End If


Wend

On Error Resume Next

spath = "location"

i = 2

bcontinue = True

While bcontinue
sFilename = Worksheets(1).Cells(i, 3).Value
If sFilename = "" Then
bcontinue = False
Else


Cells(i, 9).Select
ActiveSheet.Pictures.Insert(spath + sFilename + ".jpg").Select
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 50
Selection.ShapeRange.Width = 50
i = i + 1
End If

Wend

On Error Resume Next

spath = "location"

i = 2

bcontinue = True

While bcontinue
sFilename = Worksheets(1).Cells(i, 4).Value
If sFilename = "" Then
bcontinue = False
Else


Cells(i, 10).Select
ActiveSheet.Pictures.Insert(spath + sFilename + ".jpg").Select
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 50
Selection.ShapeRange.Width = 50
i = i + 1
End If

Wend
On Error Resume Next

spath = "location"

i = 2

bcontinue = True

While bcontinue
sFilename = Worksheets(1).Cells(i, 5).Value
If sFilename = "" Then
bcontinue = False
Else

Cells(i, 11).Select
ActiveSheet.Pictures.Insert(spath + sFilename + ".jpg").Select
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 50
Selection.ShapeRange.Width = 50
i = i + 1
End If

Wend
End Sub

I'm a 100% newbie so I'm not sure how to get the process to run once through the rows and columns I want so I just have the same code repeating 5 times to create the 5x5. Currently this works to create the 5x5 of pictures and I'm working on a way to have randomized numbers so that I can print a few cards and randomize it again and pull new photos in.

Below is what I could use some guidance on:

  • Make the pictures fit into the cell (or automatically adjust the cells to this size) with the size currently set.
  • Get the formula to skip over a blank space so I can do multiple cards at a time.
  • Not sure how to put the specific picture I want into each card. I know how I could do it (and I will) for like the first card but I'm not sure how to make it repetitively do it for each card made.

Any help is appreciated. Thank you.

解决方案

I promise this is in no way the best or fastest way to get this done but it works and I'm proud of the fact I was able to build it myself even if I did find parts of the code and had to combine them.

The code below is used to make 4 cards worth of numbers.

    Sub number()
Dim FillRange As Range, c As Range
Set FillRange = Range("A1:A5")
For Each c In FillRange
Do
c.Value = Int((15 - 1 + 1) * Rnd + 1)
Loop Until WorksheetFunction.CountIf(FillRange, c.Value) < 2
Next
End Sub
Sub number1()
Dim FillRange As Range, c As Range
Set FillRange = Range("b1:b5")
For Each c In FillRange
Do
c.Value = Int((30 - 16 + 1) * Rnd + 16)
Loop Until WorksheetFunction.CountIf(FillRange, c.Value) < 2
Next
End Sub
Sub number2()
Dim FillRange As Range, c As Range
Set FillRange = Range("c1:c5")
For Each c In FillRange
Do
c.Value = Int((45 - 31 + 1) * Rnd + 31)
Loop Until WorksheetFunction.CountIf(FillRange, c.Value) < 2
Next
End Sub
Sub number3()
Dim FillRange As Range, c As Range
Set FillRange = Range("d1:d5")
For Each c In FillRange
Do
c.Value = Int((60 - 45 + 1) * Rnd + 45)
Loop Until WorksheetFunction.CountIf(FillRange, c.Value) < 2
Next
End Sub
Sub number4()
Dim FillRange As Range, c As Range
Set FillRange = Range("e1:e5")
For Each c In FillRange
Do
c.Value = Int((75 - 61 + 1) * Rnd + 61)
Loop Until WorksheetFunction.CountIf(FillRange, c.Value) < 2
Next
End Sub



Sub number5()
Dim FillRange As Range, c As Range
Set FillRange = Range("A7:A11")
For Each c In FillRange
Do
c.Value = Int((15 - 1 + 1) * Rnd + 1)
Loop Until WorksheetFunction.CountIf(FillRange, c.Value) < 2
Next
End Sub
Sub number6()
Dim FillRange As Range, c As Range
Set FillRange = Range("b7:b11")
For Each c In FillRange
Do
c.Value = Int((30 - 16 + 1) * Rnd + 16)
Loop Until WorksheetFunction.CountIf(FillRange, c.Value) < 2
Next
End Sub
Sub number7()
Dim FillRange As Range, c As Range
Set FillRange = Range("c7:c11")
For Each c In FillRange
Do
c.Value = Int((45 - 31 + 1) * Rnd + 31)
Loop Until WorksheetFunction.CountIf(FillRange, c.Value) < 2
Next
End Sub
Sub number8()
Dim FillRange As Range, c As Range
Set FillRange = Range("d7:d11")
For Each c In FillRange
Do
c.Value = Int((60 - 45 + 1) * Rnd + 45)
Loop Until WorksheetFunction.CountIf(FillRange, c.Value) < 2
Next
End Sub
Sub number9()
Dim FillRange As Range, c As Range
Set FillRange = Range("e7:e11")
For Each c In FillRange
Do
c.Value = Int((75 - 61 + 1) * Rnd + 61)
Loop Until WorksheetFunction.CountIf(FillRange, c.Value) < 2
Next
End Sub



Sub number10()
Dim FillRange As Range, c As Range
Set FillRange = Range("A13:A17")
For Each c In FillRange
Do
c.Value = Int((15 - 1 + 1) * Rnd + 1)
Loop Until WorksheetFunction.CountIf(FillRange, c.Value) < 2
Next
End Sub
Sub number11()
Dim FillRange As Range, c As Range
Set FillRange = Range("b13:b17")
For Each c In FillRange
Do
c.Value = Int((30 - 16 + 1) * Rnd + 16)
Loop Until WorksheetFunction.CountIf(FillRange, c.Value) < 2
Next
End Sub
Sub number12()
Dim FillRange As Range, c As Range
Set FillRange = Range("c13:c17")
For Each c In FillRange
Do
c.Value = Int((45 - 31 + 1) * Rnd + 31)
Loop Until WorksheetFunction.CountIf(FillRange, c.Value) < 2
Next
End Sub
Sub number13()
Dim FillRange As Range, c As Range
Set FillRange = Range("d13:d17")
For Each c In FillRange
Do
c.Value = Int((60 - 45 + 1) * Rnd + 45)
Loop Until WorksheetFunction.CountIf(FillRange, c.Value) < 2
Next
End Sub
Sub number14()
Dim FillRange As Range, c As Range
Set FillRange = Range("e13:e17")
For Each c In FillRange
Do
c.Value = Int((75 - 61 + 1) * Rnd + 61)
Loop Until WorksheetFunction.CountIf(FillRange, c.Value) < 2
Next
End Sub





Sub number15()
Dim FillRange As Range, c As Range
Set FillRange = Range("A19:A23")
For Each c In FillRange
Do
c.Value = Int((15 - 1 + 1) * Rnd + 1)
Loop Until WorksheetFunction.CountIf(FillRange, c.Value) < 2
Next
End Sub
Sub number16()
Dim FillRange As Range, c As Range
Set FillRange = Range("b19:b23")
For Each c In FillRange
Do
c.Value = Int((30 - 16 + 1) * Rnd + 16)
Loop Until WorksheetFunction.CountIf(FillRange, c.Value) < 2
Next
End Sub
Sub number17()
Dim FillRange As Range, c As Range
Set FillRange = Range("c19:c23")
For Each c In FillRange
Do
c.Value = Int((45 - 31 + 1) * Rnd + 31)
Loop Until WorksheetFunction.CountIf(FillRange, c.Value) < 2
Next
End Sub
Sub number18()
Dim FillRange As Range, c As Range
Set FillRange = Range("d19:d23")
For Each c In FillRange
Do
c.Value = Int((60 - 45 + 1) * Rnd + 45)
Loop Until WorksheetFunction.CountIf(FillRange, c.Value) < 2
Next
End Sub
Sub number19()
Dim FillRange As Range, c As Range
Set FillRange = Range("e19:e23")
For Each c In FillRange
Do
c.Value = Int((75 - 61 + 1) * Rnd + 61)
Loop Until WorksheetFunction.CountIf(FillRange, c.Value) < 2
Next
End Sub

I did make another sub to run all of those at once.

**The code below here is what takes the numbers that are referenced from the generator on another page to pull the images from my folder which were renamed 1-75. **

Dim i As Integer
Dim sFilename As String
Dim bcontinue As Boolean
Dim spath As String

Sub Attempt1()
On Error Resume Next


spath = "C:\Users\etc."

i = 2

bcontinue = True

While bcontinue
sFilename = Worksheets(1).Cells(i, 1).Value
If sFilename = "" Then
bcontinue = False
Else

'Set Position Pic A = 1

Cells(i, 11).Select
ActiveSheet.Pictures.Insert(spath + sFilename + ".jpg").Select
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 83.25
Selection.ShapeRange.Width = 82
i = i + 1
End If
Wend

On Error Resume Next


spath = "C:\Users\etc."

i = 2

bcontinue = True

While bcontinue
sFilename = Worksheets(1).Cells(i, 3).Value
If sFilename = "" Then
bcontinue = False
Else

'Set Position Pic A = 1

Cells(i, 13).Select
ActiveSheet.Pictures.Insert(spath + sFilename + ".jpg").Select
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 83.25
Selection.ShapeRange.Width = 82
i = i + 1
End If


Wend

On Error Resume Next


spath = "C:\Users\etc."

i = 2

bcontinue = True

While bcontinue
sFilename = Worksheets(1).Cells(i, 5).Value
If sFilename = "" Then
bcontinue = False
Else

'Set Position Pic A = 1

Cells(i, 15).Select
ActiveSheet.Pictures.Insert(spath + sFilename + ".jpg").Select
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 83.25
Selection.ShapeRange.Width = 82
i = i + 1
End If


Wend

On Error Resume Next


spath = "C:\Users\etc."

i = 2

bcontinue = True

While bcontinue
sFilename = Worksheets(1).Cells(i, 7).Value
If sFilename = "" Then
bcontinue = False
Else

'Set Position Pic A = 1

Cells(i, 17).Select
ActiveSheet.Pictures.Insert(spath + sFilename + ".jpg").Select
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 83.25
Selection.ShapeRange.Width = 82
i = i + 1
End If


Wend
On Error Resume Next


spath = "C:\Users\etc."

i = 2

bcontinue = True

While bcontinue
sFilename = Worksheets(1).Cells(i, 9).Value
If sFilename = "" Then
bcontinue = False
Else

'Set Position Pic A = 1

Cells(i, 19).Select
ActiveSheet.Pictures.Insert(spath + sFilename + ".jpg").Select
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 83.25
Selection.ShapeRange.Width = 82
i = i + 1
End If


Wend
End Sub

本文地址:IT屋 » Excel VBA to build bingo cards with pictures instead of numbers

问 题



  Dim i As Integer 
Dim sFilename As String
Dim bcontinue As Boolean
Dim spath As String

Sub Attempt1()
On Error Resume Next


spath =“location”

i = 2

bcontinue = True

当bcontinue
sFilename = Worksheets(1).Cells(i, 1).Value
如果sFilename =“”然后
bcontinue = False
Else

单元格(i,7)。选择
ActiveSheet.Pictures。 Insert(spath + sFilename +“.jpg”)。选择
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 50
Selection.ShapeRange.Width = 50
i = i + 1
结束如果
Wend

关于错误简历Next


spath =“位置”

i = 2

bcontinue = True

bcontinue
sFilename = Worksheets(1).Cells(i,2).Value
如果sFilename =“”然后
bcontinue = False
Else

单元格(i,8)。选择
ActiveSheet.Pictures.Insert(spath + sFilename +“.jpg”)。选择
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 50
Selection.ShapeRange.Width = 50
i = i + 1
结束如果


Wend

关于错误恢复下一个

spath =“位置“

i = 2

bcontinue = True

bcontinue
sFilename = Worksheets(1).Cells(i,3) .Value
如果sFilename =“”然后
bcontinue = False
Else


单元格(i,9)。选择
ActiveSheet。选择
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 50
Selection.ShapeRange.Width = 50
i = i + 1
结束如果

Wend

关于错误简历Next

spath =“location”

i = 2

bcontinue = True

bcontinue
sFilename = Worksheets(1).Cells(i,4).Value
如果sFilename =“”然后
bcontinue = False
E lse


单元格(i,10)。选择
ActiveSheet.Pictures.Insert(spath + sFilename +“.jpg”)。选择
Selection.ShapeRange。 LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 50
Selection.ShapeRange.Width = 50
i = i + 1
End If

Wend
On Error Resume Next

spath =“location”

i = 2

bcontinue = True

虽然bcontinue
sFilename = Worksheets(1).Cells(i,5).Value
如果sFilename =“”然后
bcontinue = False
Else

单元格(i,11)。选择
ActiveSheet.Pictures.Insert(spath + sFilename +“.jpg”)。选择
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 50
Selection.ShapeRange.Width = 50
i = i + 1
结束如果

Wend
End Sub


我是一个100%的新手,所以我不知道如何让进程运行一次通过我想要的行和列,所以我只是有相同的代码重复5次创建5x5。目前,这项工作是为了创建5x5的图片,我正在开发一种随机数字的方法,以便我可以打印几张卡片并随机再次使用。



以下是我可以使用一些指导:




  • 使图片适合单元格(或自动调整单元格

  • 获取公式以跳过空格,以便一次可以多张卡片。

  • 不知道如何把我想要的具体图片放入每张卡。我知道我可以如何做(我会的)像第一张卡,但我不知道如何使它重复地为每张卡做的。



任何帮助都不胜感激。谢谢。


解决方案

我保证,这绝对不是最好的或最快的方式来完成这项工作,我感到自豪的是,即使我找到了代码的一部分,并且必须将它们组合起来,我自己也可以自己构建。



使用下面的代码制作4张卡片的数字。



 子号()
Dim FillRange As Range,c作为范围
设置FillRange =范围(“A1:A5”)
对于每个c在FillRange
Do
c.Value = Int((15 - 1 + 1)* Rnd + 1)
循环直到WorksheetFunction.CountIf(FillRange,c.Value) 2
下一个
End Sub
Sub number1()
Dim FillRange As Range,c As Range
Set FillRange = Range(“b1:b5”)
For Each c In FillRange
Do
c.Value = Int((30 - 16 + 1)* Rnd + 16)
循环直到WorksheetFunction.CountIf(FillRange,c.Value)< ; 2
下一个
End Sub
Sub number2()
Dim FillRange As Range,c As Range
Set FillRange = Range(“c1:c5”)
For Each c In FillRange
Do
c.Value = Int((45 - 31 + 1)* Rnd + 31)
循环直到WorksheetFunction.CountIf(FillRange,c.Value)< ; 2
下一个
End Sub
Sub number3()
Dim FillRange As Range,c As Range
Set FillRange = Range(“d1:d5”)
For Each c In FillRange
Do
c.Value = Int((60 - 45 + 1)* Rnd + 45)
循环直到WorksheetFunction.CountIf(FillRange,c.Value)< ; 2
下一个
End Sub
Sub number4()
Dim FillRange As Range,c As Range
Set FillRange = Range(“e1:e5”)
For Each c In FillRange
Do
c.Value = Int((75 - 61 + 1)* Rnd + 61)
循环直到WorksheetFunction.CountIf(FillRange,c.Value)< ; 2
下一个
End Sub



Sub number5()
Dim FillRange As Range,c As Range
Set FillRange =范围(“A7:A11”)
对于每个c在FillRange
Do
c.Value = Int((15 - 1 + 1)* Rnd + 1)
循环直到WorksheetFunction.CountIf(FillRange,c.Value) 2
下一个
End Sub
Sub number6()
Dim FillRange As Range,c As Range
Set FillRange = Range(“b7:b11”)
For Each c In FillRange
Do
c.Value = Int((30 - 16 + 1)* Rnd + 16)
循环直到WorksheetFunction.CountIf(FillRange,c.Value)< ; 2
下一个
End Sub
Sub number7()
Dim FillRange As Range,c As Range
Set FillRange = Range(“c7:c11”)
For Each c In FillRange
Do
c.Value = Int((45 - 31 + 1)* Rnd + 31)
循环直到WorksheetFunction.CountIf(FillRange,c.Value)< ; 2
下一个
End Sub
Sub number8()
Dim FillRange As Range,c As Range
Set FillRange = Range(“d7:d11”)
For Each c In FillRange
Do
c.Value = Int((60 - 45 + 1)* Rnd + 45)
循环直到WorksheetFunction.CountIf(FillRange,c.Value)< ; 2
下一个
End Sub
Sub number9()
Dim FillRange As Range,c As Range
Set FillRange = Range(“e7:e11”)
For Each c In FillRange
Do
c.Value = Int((75 - 61 + 1)* Rnd + 61)
循环直到WorksheetFunction.CountIf(FillRange,c.Value)< ; 2
下一个
End Sub



子编号10()
Dim FillRange As Range,c As Range
Set FillRange =范围(“A13:A17”)
对于每个c在FillRange
Do
c.Value = Int((15 - 1 + 1)* Rnd + 1)
循环直到WorksheetFunction.CountIf(FillRange,c.Value) 2
下一个
End Sub
Sub number11()
Dim FillRange As Range,c As Range
Set FillRange = Range(“b13:b17”)
For Each c In FillRange
Do
c.Value = Int((30 - 16 + 1)* Rnd + 16)
循环直到WorksheetFunction.CountIf(FillRange,c.Value)< ; 2
下一个
End Sub
Sub number12()
Dim FillRange As Range,c As Range
Set FillRange = Range(“c13:c17”)
For Each c In FillRange
Do
c.Value = Int((45 - 31 + 1)* Rnd + 31)
循环直到WorksheetFunction.CountIf(FillRange,c.Value)< ; 2
下一个
End Sub
Sub number13()
Dim FillRange As Range,c As Range
Set FillRange = Range(“d13:d17”)
For Each c In FillRange
Do
c.Value = Int((60 - 45 + 1)* Rnd + 45)
循环直到WorksheetFunction.CountIf(FillRange,c.Value)< ; 2
下一个
End Sub
Sub number14()
Dim FillRange As Range,c As Range
Set FillRange = Range(“e13:e17”)
For Each c In FillRange
Do
c.Value = Int((75 - 61 + 1)* Rnd + 61)
循环直到WorksheetFunction.CountIf(FillRange,c.Value)< ; 2
下一个
End Sub





子号码15()
Dim FillRange As Range,c作为范围
设置FillRange =范围(“A19:A23”)
对于每个c在FillRange
Do
c.Value = Int((15 - 1 + 1)* Rnd + 1)
循环直到WorksheetFunction.CountIf(FillRange,c.Value) 2
下一个
End Sub
Sub number16()
Dim FillRange As Range,c As Range
Set FillRange = Range(“b19:b23”)
For Each c In FillRange
Do
c.Value = Int((30 - 16 + 1)* Rnd + 16)
循环直到WorksheetFunction.CountIf(FillRange,c.Value)< ; 2
下一个
End Sub
Sub number17()
Dim FillRange As Range,c As Range
Set FillRange = Range(“c19:c23”)
For Each c In FillRange
Do
c.Value = Int((45 - 31 + 1)* Rnd + 31)
循环直到WorksheetFunction.CountIf(FillRange,c.Value)< ; 2
下一个
End Sub
Sub number18()
Dim FillRange As Range,c As Range
Set FillRange = Range(“d19:d23”)
For Each c In FillRange
Do
c.Value = Int((60 - 45 + 1)* Rnd + 45)
循环直到WorksheetFunction.CountIf(FillRange,c.Value)< ; 2
下一个
End Sub
Sub number19()
Dim FillRange As Range,c As Range
Set FillRange = Range(“e19:e23”)
For Each c In FillRange
Do
c.Value = Int((75 - 61 + 1)* Rnd + 61)
循环直到WorksheetFunction.CountIf(FillRange,c.Value)< ; 2
下一个
End Sub



让另一个子程序一次运行所有这些。



**下面的代码是从另一页面上的生成器引用的数字来拉取图像从我的文件夹
更名为1-75。 **




  Dim i As Integer 
Dim sFilename As String
Dim bcontinue As Boolean
Dim spath As String

Sub Attempt1()
On Error Resume Next


spath =“C:\\ \\Users\etc“。

i = 2

bcontinue = True

bcontinue
sFilename = Worksheets(1).Cells(i,1).Value
如果sFilename =“”然后
bcontinue = False
Else

'设置位置图A = 1

单元格(i,11 )。选择
ActiveSheet.Pictures.Insert(spath + sFilename +“.jpg”)。选择
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 83.25
Selection.ShapeRange.Width = 82
i = i + 1
结束如果
Wend

关于错误简历Next


spath =“C:\Users\etc”。

i = 2

bcontinue = True

虽然bcontinue
sFilename = Worksheets(1).Cells(i,3).Value
如果sFilename =“”然后
bcontinue = False
Else

'设置位置图A = 1

单元格(i,13 )。选择
ActiveSheet.Pictures.Insert(spath + sFilename +“.jpg”)。选择
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 83.25
Selection.ShapeRange.Width = 82
i = i + 1
结束如果


Wend

关于错误简历Next


spath =“C:\Users\etc”。

i = 2

bcontinue = True

虽然bcontinue
sFilename = Worksheets(1).Cells(i,5).Value
如果sFilename =“”然后
bcontinue = False
Else

'设置位置图A = 1

单元格(i,15 )。选择
ActiveSheet.Pictures.Insert(spath + sFilename +“.jpg”)。选择
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 83.25
Selection.ShapeRange.Width = 82
i = i + 1
结束如果


Wend

关于错误简历Next


spath =“C:\Users\etc”。

i = 2

bcontinue = True

bcontinue
sFilename = Worksheets(1).Cells(i,7).Value
如果sFilename =“”然后
bcontinue = False
Else

'设置位置图A = 1

单元格(i,17 )。选择
ActiveSheet.Pictures.Insert(spath + sFilename +“.jpg”)。选择
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 83.25
Selection.ShapeRange.Width = 82
i = i + 1
如果


Wend
错误简历Next


spath =“C:\Users\etc”。

i = 2

bcontinue = True

bcontinue
sFilename = Worksheets(1).Cells(i,9).Value
如果sFilename =“”然后
bcontinue = False
Else

'设置位置图A = 1

单元格(i,19 )。选择
ActiveSheet.Pictures.Insert(spath + sFilename +“.jpg”)。选择
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 83.25
Selection.ShapeRange.Width = 82
i = i + 1
End If


Wend
End Sub

本文地址:IT屋 » Excel VBA构建宾果卡与图片,而不是数字