VBA代码只能在sheet表使用，模块上使用不了

十二三

路过的大神帮帮忙！帮我看一下为什么我图片预览的代码可以在sheet表中使用，但是放置在模块中就使用不了了，我想可以适用于全部工作表的

lixikao

表格打不开

十二三

lixikao 发表于 2024-1-19 13:52
表格打不开

不好意思，公司有excel密码保护，我发一下代码给你看一下
Option Explicit

Dim EnablePreview As Boolean

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim selectedProductCode As String
    Dim picturePath As String
    Dim previewPicture As Picture

    ' Check if the preview is enabled
    If EnablePreview Then
        ' Check if the selected cell is in the first column (商品代码列)
        If Target.Column = 1 Then
            ' Get the product code from the selected cell
            selectedProductCode = CStr(Target.Value)

            ' Disable events
            Application.EnableEvents = False

            ' Assume the picture path corresponds to the product code
            picturePath = GetPicturePath(selectedProductCode)

            ' Delete the previous preview picture (if it exists)
            DeletePreviewPicture

            ' Insert a new preview picture
            Set previewPicture = Me.Pictures.Insert(picturePath)
            With previewPicture
                .Top = Target.Top
                .Left = Target.Offset(0, 1).Left ' Display the picture in the adjacent column
                .Width = 100
                .Height = 100
                .Name = "PreviewPicture" ' Set the picture name for later deletion
            End With

            ' Enable events
            Application.EnableEvents = True
        End If
    End If
End Sub

Function GetPicturePath(productCode As String) As String
    ' Assume pictures are stored in a folder named "ProductImages"
    Dim pictureFolder As String
    pictureFolder = "E:\图片\新建文件夹\"

    ' Build the complete picture path
    GetPicturePath = pictureFolder & productCode & ".jpg"
End Function

Sub DeletePreviewPicture()
    ' Delete the picture named "PreviewPicture"
    On Error Resume Next
    Me.Shapes("PreviewPicture").Delete
    On Error GoTo 0
End Sub

' Toggle the EnablePreview variable to enable or disable the preview
Sub TogglePreview()
    EnablePreview = Not EnablePreview
End Sub

十二三

Option Explicit

Dim EnablePreview As Boolean

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim selectedProductCode As String
    Dim picturePath As String
    Dim previewPicture As Picture

    ' Check if the preview is enabled
    If EnablePreview Then
        ' Check if the selected cell is in the first column (商品代码列)
        If Target.Column = 1 Then
            ' Get the product code from the selected cell
            selectedProductCode = CStr(Target.Value)

            ' Disable events
            Application.EnableEvents = False

            ' Assume the picture path corresponds to the product code
            picturePath = GetPicturePath(selectedProductCode)

            ' Delete the previous preview picture (if it exists)
            DeletePreviewPicture

            ' Insert a new preview picture
            Set previewPicture = Me.Pictures.Insert(picturePath)
            With previewPicture
                .Top = Target.Top
                .Left = Target.Offset(0, 1).Left ' Display the picture in the adjacent column
                .Width = 100
                .Height = 100
                .Name = "PreviewPicture" ' Set the picture name for later deletion
            End With

            ' Enable events
            Application.EnableEvents = True
        End If
    End If
End Sub

Function GetPicturePath(productCode As String) As String
    ' Assume pictures are stored in a folder named "ProductImages"
    Dim pictureFolder As String
    pictureFolder = "E:\图片\新建文件夹\"

    ' Build the complete picture path
    GetPicturePath = pictureFolder & productCode & ".jpg"
End Function

Sub DeletePreviewPicture()
    ' Delete the picture named "PreviewPicture"
    On Error Resume Next
    Me.Shapes("PreviewPicture").Delete
    On Error GoTo 0
End Sub

' Toggle the EnablePreview variable to enable or disable the preview
Sub TogglePreview()
    EnablePreview = Not EnablePreview
End Sub


这是代码，表格因为公司加密  打不开

过客fppt

这个代码是必须放在sheet表中的，只有sheet表中有这个代码，才能触发对应的事件



建议你在每个sheet表中都加入：
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
call 图片预览程序
end sub

而 “图片预览程序”，你要从那些代码中分离出来，放在模块中编写为独立的程序，需要时再调用即可