Question

我正在使用以下私有功能代码的多个实例来在Excel表单中显示多个图像。工作正常。我可以使用这些小的html容器在窗体上的不同位置放置图像。但是我需要能够调整所显示图像的亮度和对比度。

过去，在另一个项目中，我直接在工作表上显示图像，然后使用以下代码更改亮度（以及类似的对比度）。但是我没有弄清楚如何针对此项目在窗体上显示图像。我真的可以帮忙。

以下是在不同项目中用于增加工作表中显示的所有图像的亮度的代码。类似的代码用于降低亮度和增加/降低对比度。

Sub BumpContrastUp()
    gvarGlobalContrast = gvarGlobalContrast + 0.05
    Dim shape As Excel.shape
    Dim cnt As Long
    cnt = 0
    For Each shape In ActiveSheet.Shapes
        If shape.Type = msoLinkedPicture Then
            shape.PictureFormat.Contrast = gvarGlobalContrast
        End If
    Next shape
End Sub

以下是用于在表单上显示图像的代码。几个HTML容器（末尾）用于在表单上显示不同的图像（每个容器一个图像）。注意：我已经剪掉了一大堆代码，并试图只留下与您相关的内容，以查看发生了什么。最后，我需要更改picURL1和picURL2的亮度和对比度。

Private Sub UserForm_Initialize()
    With frmImageReview
        .Caption = Sheets("Configuration").Range("B2").Value
        .Height = Sheets("Configuration").Range("B3").Value
        .Width = Sheets("Configuration").Range("B4").Value
    End With
        'BUTTONS ---------------------------------------------------
        With frmImageReview.cmdOK
            .Top = Sheets("Configuration").Range("J21").Value
            .Left = Sheets("Configuration").Range("J22").Value
        End With
        With frmImageReview.cmdBrightPlus
            .Top = Sheets("Configuration").Range("J24").Value
            .Left = Sheets("Configuration").Range("J25").Value
        End With
        With frmImageReview.cmdBrightNeg
            .Top = Sheets("Configuration").Range("K24").Value
            .Left = Sheets("Configuration").Range("K25").Value
        End With
        With frmImageReview.cmdContrastPlus
            .Top = Sheets("Configuration").Range("L24").Value
            .Left = Sheets("Configuration").Range("L25").Value
        End With
        With frmImageReview.cmdContrastNeg
            .Top = Sheets("Configuration").Range("M24").Value
            .Left = Sheets("Configuration").Range("M25").Value
        End With
    'HEIGHT/WIDTH FACTORS (for use in setting height/width in web browsers)
    With Sheets("Configuration")
        HWF1 = .Range("B" & IVProw + 6).Value
        HWF2 = .Range("C" & IVProw + 6).Value
    End With

    With WebBrowser1
        .Height = Sheets("Configuration").Range("B" & IVProw + 1).Value
        .Width = Sheets("Configuration").Range("B" & IVProw + 2).Value
        .Top = Sheets("Configuration").Range("B" & IVProw + 3).Value
        .Left = Sheets("Configuration").Range("B" & IVProw + 4).Value
        .Visible = Sheets("Configuration").Range("B" & IVProw + 5).Value
    End With
    With WebBrowser2
        .Height = Sheets("Configuration").Range("C" & IVProw + 1).Value
        .Width = Sheets("Configuration").Range("C" & IVProw + 2).Value
        .Top = Sheets("Configuration").Range("C" & IVProw + 3).Value
        .Left = Sheets("Configuration").Range("C" & IVProw + 4).Value
        .Visible = Sheets("Configuration").Range("C" & IVProw + 5).Value
    End With
    GetImage
    cmdClearForm_Click
End Sub

Private Sub GetImage()
    With Sheets("Configuration")
        displayPath = Sheets("Configuration").Range("B8") 'Local
        CFIb1 = Sheets("Configuration").Range("B" & IVProw + 8).Value
        CFIb2 = Sheets("Configuration").Range("C" & IVProw + 8).Value
    End With
    picURL1 = displayPath & "\" & Sheets("Image URLs").Range(CFIb1 & r + rDiff)
    picURL2 = displayPath & "\" & Sheets("Image URLs").Range(CFIb2 & r + rDiff)
        fnCreateHTML1 (picURL1)
        fnCreateHTML2 (picURL2)
        Me.WebBrowser1.Navigate strPath & "Tmp1.html"
        Me.WebBrowser2.Navigate strPath & "Tmp2.html"
End Sub


'//-----------------------------------------
'// Author    : "Ivan F Moala"
'// Site      : "http://www.xcelfiles.com"
'-------------------------------------------
Private Function fnCreateHTML1(strImgFilePath As String)
    Dim hdl As Long, m_Width1 As Long, m_Height1 As Long
    Dim strAp1 As String

strAp1 = Chr(34)
m_Width1 = WebBrowser1.Width * HWF1
m_Height1 = WebBrowser1.Height * HWF1
hdl = FreeFile

    Open strPath & "Tmp1.html" For Output As #hdl
        Print #hdl, "<HTML>"
        Print #hdl, "<CENTER>"
        Print #hdl, "<BODY"
        Print #hdl, "Scroll = ""YES"""
        Print #hdl, "LEFTMARGIN=0"
        Print #hdl, "TOPMARGIN=0"
        Print #hdl, "</BODY>"
        Print #hdl, "<IMG width= " & m_Width1 & _
                    " height= " & m_Height1 & _
                    " SRC = " & strAp1 & picURL1 & strAp1 & _
                    "; Border = 0>"
        Print #hdl, "</CENTER>"
        Print #hdl, "</HTML>"
    Close hdl
End Function


Private Function fnCreateHTML2(strImgFilePath As String)
    Dim hd2 As Long, m_Width2 As Long, m_Height2 As Long
    Dim strAp2 As String

strAp2 = Chr(34)
m_Width2 = WebBrowser2.Width * HWF2
m_Height2 = WebBrowser2.Height * HWF2
hd2 = FreeFile

    Open strPath & "Tmp2.html" For Output As #hd2
        Print #hd2, "<HTML>"
        Print #hd2, "<CENTER>"
        Print #hd2, "<BODY"
        Print #hd2, "Scroll = ""YES"""
        Print #hd2, "LEFTMARGIN=0"
        Print #hd2, "TOPMARGIN=0"
        Print #hd2, "</BODY>"
        Print #hd2, "<IMG width= " & m_Width2 & _
                    " height= " & m_Height2 & _
                    " SRC = " & strAp2 & picURL2 & strAp2 & _
                    "; Border = 0>"
        Print #hd2, "</CENTER>"
        Print #hd2, "</HTML>"
    Close hd2
End Function

使用VBA在Excel表单中控制图像的亮度和对比度

0 个答案: