求问，EXCEL的窗体怎么批量修改？

茜良涧

如图，我的EXCEL窗体是这样的，不点的时候是没有颜色填充，点一下会变成红色的，点两下会变成黑色的。

我的每个EXCEl有6张表，每个表中有大量的这样的窗体。
而像这样的EXCEL我有一百来个。
每当我要改一样的东西的时候，这百来个EXCEL都要一起跟着修改。
里面的文字内容我可以录制VBA批量修改，窗体无法录制啊。
一个手动改确实很痛苦，求大佬们支招，跪谢啊。

zpy2

个表中有大量的这样的窗体。
窗体是uerform?

茜良涧

zpy2 发表于 2019-6-22 13:59
个表中有大量的这样的窗体。
窗体是uerform?

不懂什么是uerform.我打开VBA有如下三个macro：
sheet1.ChangeColor
sheet1.PasswordBreaker
sheet1.RunRebuildTables
不知道三个是不是都有用。
由于电脑限制不能传文件，三个macro的代码我放一下，以End Sub做间隔：

Sub ChangeColor()

Dim WhichSheet As String

WhichSheet = Application.Caller
With ActiveSheet.Shapes(WhichSheet)
    Select Case .Child
    Case msoFalse
   
        If .Fill.Visible = msoFalse Then .Fill.Visible = msoTrue
        Select Case .Fill.ForeColor.RGB
        Case RGB(255, 255, 255)
            .Fill.ForeColor.RGB = RGB(255, 0, 0)
        Case RGB(255, 0, 0)
            .Fill.ForeColor.RGB = RGB(0, 0, 0)
        Case Else
            .Fill.ForeColor.RGB = RGB(255, 255, 255)
        End Select
   
    Case msoTrue
        
        If .ParentGroup.Fill.Visible = msoFalse Then .Fill.Visible = msoTrue
        Select Case .ParentGroup.Fill.ForeColor.RGB
        Case RGB(255, 255, 255)
            .ParentGroup.Fill.ForeColor.RGB = RGB(255, 0, 0)
        Case RGB(255, 0, 0)
            .ParentGroup.Fill.ForeColor.RGB = RGB(0, 0, 0)
        Case Else
            .ParentGroup.Fill.ForeColor.RGB = RGB(255, 255, 255)
        End Select
    End Select

End With
End Sub

Sub PasswordBreaker()
    'Author JKZ
    'Breaks worksheet password protection.
    Dim i As Integer, j As Integer, k As Integer
    Dim l As Integer, m As Integer, n As Integer
    Dim i1 As Integer, i2 As Integer, i3 As Integer
    Dim i4 As Integer, i5 As Integer, i6 As Integer
    On Error Resume Next
    For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
    For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
    For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
    For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
    ActiveSheet.Unprotect Chr(i) & Chr(j) & Chr(k) & _
        Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
        Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
    If ActiveSheet.ProtectContents = False Then
        MsgBox "One usable password is " & Chr(i) & Chr(j) & _
            Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
            Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
         Exit Sub
    End If
    Next: Next: Next: Next: Next: Next
    Next: Next: Next: Next: Next: Next
End Sub

Sub RunRebuildTables()

Dim ctrls As CommandBarControls
Dim ctrl As CommandBarControl
Dim ctrls2 As CommandBarControls
Dim ctrl2 As CommandBarControl

    Set ctrls = Application.CommandBars.FindControls(, , , True)

    For Each ctrl In ctrls
        If ctrl.Caption = "F&luor FFD" Then
            Set ctrls2 = ctrl.Controls
            For Each ctrl2 In ctrls2
                'Debug.Print ctrl2.Caption
                If ctrl2.Caption = "Re&build Tables in Spreadsheet" Then
                    ctrl2.Execute
                    Exit Sub
                End If
            Next
        End If
    Next

End Sub

茜良涧

zpy2 发表于 2019-6-22 13:59
个表中有大量的这样的窗体。
窗体是uerform?

求救命啊/大哭

zpy2

茜良涧 发表于 2019-6-24 09:24
求救命啊/大哭

ActiveSheet.Shapes
看着像形状，你手动挡咋改的，具体改哪些内容？没有附件，就是要搞清楚比较麻烦的。

茜良涧

zpy2 发表于 2019-6-24 09:29
ActiveSheet.Shapes
看着像形状，你手动挡咋改的，具体改哪些内容？没有附件，就是要搞清楚比较麻烦的。

手动要变色就点击那个圆圈就行了，点一下变红色，点两下变黑色，三下还原。
公司电脑限制不能发文件，我有一个类似的表，可以发邮箱。
能否留个邮箱我发你看看？

zpy2

WhichSheet = Application.Caller
debug.print whichsheet
'工作表名称
'下面是设置颜色的f8单步运行下就知道了
With ActiveSheet.Shapes(WhichSheet)
   
     .Fill.Visible = msoTrue
            .Fill.ForeColor.RGB = RGB(255, 0, 0)
            .Fill.ForeColor.RGB = RGB(255, 255, 255)
End with
   
然后，循环就可以了。我是手机没法调试vba的。

茜良涧

zpy2 发表于 2019-6-24 11:31
WhichSheet = Application.Caller
debug.print whichsheet
'工作表名称

你好，我把 Application.Caller改成了我需要改的工作表名称sheet1，然后运行到With ActiveSheet.Shapes(WhichSheet)这一步就出错了。。。
那个sheet1我没改运行也出错了。。。
还有个问题，我那个表那么多的小圆圈，我如何定位到我需要修改的小圆圈呢？

茜良涧

zpy2 发表于 2019-6-24 11:31
WhichSheet = Application.Caller
debug.print whichsheet
'工作表名称

这个东西能不能像修改文字那样录制VBA呢？

zpy2

茜良涧 发表于 2019-6-24 13:25
你好，我把 Application.Caller改成了我需要改的工作表名称sheet1，然后运行到With ActiveSheet.Shapes(W ...

Sub ChangeColor()

Dim WhichSheet As String

WhichSheet = Application.Caller
With ActiveSheet.Shapes(WhichSheet)
stop '这里在本地窗口 看看 activesheet是那个sheet
    Select Case .Child
stop '这里中断 看看 child是 那个控件
    Case msoFalse
   
        If .Fill.Visible = msoFalse Then
stop '看看fill是啥
.Fill.Visible = msoTrue
        Select Case .Fill.ForeColor.RGB
        Case RGB(255, 255, 255)
            .Fill.ForeColor.RGB = RGB(255, 0, 0)
        Case RGB(255, 0, 0)
            .Fill.ForeColor.RGB = RGB(0, 0, 0)
        Case Else
            .Fill.ForeColor.RGB = RGB(255, 255, 255)
        End Select
   
    Case msoTrue
        
        If .ParentGroup.Fill.Visible = msoFalse Then .Fill.Visible = msoTrue
        Select Case .ParentGroup.Fill.ForeColor.RGB
        Case RGB(255, 255, 255)
            .ParentGroup.Fill.ForeColor.RGB = RGB(255, 0, 0)
        Case RGB(255, 0, 0)
            .ParentGroup.Fill.ForeColor.RGB = RGB(0, 0, 0)
        Case Else
            .ParentGroup.Fill.ForeColor.RGB = RGB(255, 255, 255)
        End Select
    End Select

End With
End Sub
这样子应该可以理解一下，如果还解决不了，就上传附件吧，