Excel VBA:在"是/否"下拉菜单中显示/隐藏图片;同时进行故障排除.可见

Question

请原谅，我对VBA一无所知，我有一个疯狂的想法，那就是制作圣诞礼物，在Excel中以数字方式复制刮刮乐清单或小说海报。在经历了很多挫折之后，我终于能够用单独的下拉菜单打开/关闭一张图片("未读"/"完整"(。这是一个大的书名表，封面被隐藏起来，直到每一本都被标记为"完成"，然后封面就会显示出来。

问题是一次只显示一个图像。如果有两本书被标记为"完成"，则只显示最近更改为"完整"的那本书。这是因为我让他们都在同一个潜艇上运行吗？我是否需要为每个图像单独使用一个Sub(即100个Sub(？

Snippet，假设只有5本书：

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B4")) Is Nothing Then
Shapes("Picture 1").Visible = Range("B4").Value = "Complete"
Else
Shapes("Picture 1").Visible = False
End If
If Not Intersect(Target, Range("D4")) Is Nothing Then
Shapes("Picture 2").Visible = Range("D4").Value = "Complete"
Else
Shapes("Picture 2").Visible = False
End If
If Not Intersect(Target, Range("F4")) Is Nothing Then
Shapes("Picture 3").Visible = Range("F4").Value = "Complete"
Else
Shapes("Picture 3").Visible = False
End If
If Not Intersect(Target, Range("H4")) Is Nothing Then
Shapes("Picture 4").Visible = Range("H4").Value = "Complete"
Else
Shapes("Picture 4").Visible = False
End If
If Not Intersect(Target, Range("J4")) Is Nothing Then
Shapes("Picture 5").Visible = Range("J4").Value = "Complete"
Else
Shapes("Picture 5").Visible = False
End If
End Sub 

我相信有一些更有效的方法可以做到这一点，但我更关心的是让图像独立于其他图像的可见值显示。谢谢

编辑：很抱歉我的解释不够清楚。不幸的是，我没有足够的声誉来分享一张照片。书的封面有10列，10行。每隔一列保存图像(中间是间隔符(。行数见下文。

当标记为"；未读"；在下面的单元格中，图像应该被隐藏。当标记为"；完整的"；下面，图像应该显示出来。

解释单元格布局：

• B2保存图像
• B3获得冠军
• B4保存数据验证下拉列表(VBA检查B2的可见图像值(

电子表格布局：

• B2:T2具有前10个图像，因此
• B4:T4具有前10个数据验证下拉列表
• B7:T7下一个下拉菜单
• B10:T10〃">
• B13:T13，然后B16:T16，B19:T19，B22:T22，B25:T25，B28:T28，B31:T31

https://i.stack.imgur.com/zX5pV.jpg

Answer 1

我不能100%确定我是否正确理解了您的问题，但我只是尝试将代码中重复的部分放入循环中。此外，它现在不会再次使图片不可见。如果你不熟悉我使用的Cells属性，你可以在这里找到更多信息。

此外，我将这段代码拆分为：

Shapes("Picture 1").Visible = Range("B4").Value = "Complete"

这是怎么回事？我想你希望照片是可见的，而细胞显示"；完成"。。。

循环内的图片名称由"Picture " & i的字符串串联创建

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i as Long
Dim totalNumberOfPictures as Long
totalNumberOfPictures = 8 'Input number of pictures you have here
For i=1 To totalNumberOfPictures 
If Not Intersect(Target, Cells(4, 2 * i)) Is Nothing Then
Shapes("Picture " & i).Visible = True
Cells(4, 2 * i) = "Complete"
End If
Next i
End Sub

或者，如果你指的是分配的单元格值被更改为"0"的每一张图片；完整的"；应该是可见的，您可以尝试以下操作：编辑：已更新以解决您问题中添加的详细信息。。。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i as Long
Dim totalNumberOfPictures as Long
Dim count as Long
Dim rowOffset as Long
totalNumberOfPictures = 100 'Input number of pictures you have here
count = 1
rowOffset = 0
For i=1 To totalNumberOfPictures 
If Cells(4 +  rowOffset, 2 * count) = "Complete" Then
Shapes("Picture " & i).Visible = True
Else
Shapes("Picture " & i).Visible = False
End If
If count = 10 Then   ' 10 is the number of pictures per "row"
rowOffset = rowOffset + 3   ' 3 is the row difference between  your dropdown rows
count = 0
End if
count = count+ 1
Next i
End Sub

让我知道它是否有效，或者这不是你的意思，你真正想要的。。。

Answer 2

如果这是我的项目，我会用稍微不同的方式来做。我会提出这个建议——如果它不适合你，请告诉我；我会删除它。

第1步–重命名图片以匹配书名。这一开始会让人厌烦，但这意味着你不会被束缚在基于"图片#"的循环中，因为图片名称可能会有所不同。也使名称更加直观。

步骤2–将下面的代码复制到标准模块&当你在有照片的纸上时运行它。它将创建一个命名的非连续范围。如果你看一下代码，很明显你可以随着时间的推移对它进行调整，以适应你不断变化的需求。只需根据需要添加更多范围并重新运行即可。

Sub MakeRangeName()
ActiveSheet.Range _
("B4:T4,B7:T7,B10:T10,B13:T13,B16:T16,B19:T19,B22:T22,B25:T25,B28:T28,B31:T31") _
.Name = "myRange"
End Sub

第3步–将下面的代码复制到有图片的工作表代码模块中。只要您在步骤2中创建的范围发生变化，它就会运行，但只会影响实际感兴趣的图片。

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo GetOut
Application.EnableEvents = False
Dim s As String
If Not Intersect(Range("myRange"), Target) Is Nothing Then
If ActiveCell.Offset(-1, 0) = "" Then GoTo Letscontinue '<< to ignore the inbetween columns
s = ActiveCell.Offset(-1, 0).Text
If ActiveCell.Value = "Complete" Then
ActiveSheet.Shapes(s).Visible = True
Else
ActiveSheet.Shapes(s).Visible = False
End If       
End If
Letscontinue:
Application.EnableEvents = True
Exit Sub
GetOut:
MsgBox Err.Description
Resume Letscontinue
End Sub

我已经测试过了，它对我有效。如果你有什么问题，请告诉我。