更新按钮的替代文本

时间:2017-06-26 21:58:17

标签: vba excel-vba excel

我将以下代码作为Job site劳动力表单的一部分,该表单将“LocLabor”表上的完整人工调用链接到各种单日登录表。这个特殊的代码是为表单添加一整天,并且效果很好,但底部的这两行除外:

 .Buttons(bnum).ShapeRange.AlternativeText = dayint + 1
 .Buttons(bnum + 1).ShapeRange.AlternativeText = dayint + 1 

“scopy”,“ecopy”和“brow”变量用于计算出适当的行以复制并粘贴到第二天。要更改的按钮是在scopy / ecopy范围内复制的新粘贴按钮,用于添加或删除它们引用的表中的行。我需要能够更改AltText,因为我使用它作为他们适用的劳动力调用日的参考。 “numdays”变量来自locsht.Range(“L3”)。Value,在运行宏之前设置为表单上的当前天数。因此,当我看到错误时,它的值为2

现在问题 - 如果我在文档中存在两天并且执行下面的代码,则按钮的名称会更改,但替代文本不会更改(它仍为“2”或之前的任何内容复印)。第4天和第4天工作完美,只是从第2天到第3天的过渡,我无法上班!如果我将“dayint + 1”切换为字符串,例如“香蕉”,它也有效,但这显然对我没有帮助。

任何想法都将不胜感激。

Option Explicit
Sub add_day()
Dim numdays As String
Dim tbl As TableStyle
Dim newsht As Worksheet
Dim locsht As Worksheet
Dim scopy As Integer
Dim ecopy As Integer
Dim brow As Integer
Dim dayint As Integer
Dim bnum As Integer
Dim tblstart As String

Application.ScreenUpdating = False
'unlock sheet
Worksheets("LocLabor").Unprotect Password:=SuperSecretPW

'set/get variables
Set locsht = Worksheets("LocLabor")
numdays = locsht.Range("L3").Value
dayint = numdays
Worksheets("Labor Sign In Day " & numdays).Copy Before:=Sheets(numdays + 4)
Worksheets("Labor Sign In Day " & numdays & " (2)").Name = "Labor Sign In Day " & numdays + 1

'update number of days on sheet
locsht.Range("L3") = locsht.Range("L3").Value + 1

'rename new sign in sheet
Set newsht = Worksheets("Labor Sign In Day " & numdays + 1)
newsht.Unprotect Password:=SuperSecretPW

'figure out which rows to copy on main sheet
scopy = locsht.ListObjects(dayint).Range.Rows(1).Row - 1
brow = locsht.ListObjects(dayint).Range.Rows.Count
ecopy = scopy + brow


'Copy/paste new day on LocLabor
locsht.Activate
locsht.Rows(scopy & ":" & ecopy).Copy
locsht.Rows(ecopy + 2).Insert Shift:=xlDown
locsht.ListObjects("Tableday" & numdays).Resize Range("A" & scopy + 1 & ":" & "H" & ecopy)
locsht.Range("A" & ecopy + 2 & ":" & "H" & ecopy + 2) = "=IFERROR($A$17+" & numdays & "," & """Enter Load in Date at Top"")"
locsht.Rows(ecopy + 1).EntireRow.Delete
locsht.PageSetup.PrintArea = "$A$1:$H$" & ecopy + (ecopy - scopy + 1)
locsht.HPageBreaks.Add Before:=locsht.Rows(ecopy + 1)
locsht.ListObjects(dayint + 1).Name = "Tableday" & numdays + 1

bnum = (dayint * 2) + 3

tblstart = locsht.ListObjects(dayint + 1).Range.Rows(1).Row + 1

'Enter correct formulas into sign in sheet
With newsht
.ListObjects(1).Name = "signinday" & numdays + 1
.Range("i12") = Left(newsht.Range("i12").Formula, 28) & numdays & Right(newsht.Range("i12").Formula, 48)
.Range("A17") = "=IF(ISBLANK(LocLabor!G" & tblstart & ")=FALSE,LocLabor!G" & tblstart & "&"" ""&LocLabor!F" _
& tblstart & ",IF(ISBLANK(LocLabor!D" & tblstart & ")=TRUE," & """""" & ",LocLabor!D" & tblstart & "))"
.Range("B17") = "=IF(ISBLANK(LocLabor!B" & tblstart & ")=TRUE, """", LocLabor!B" & tblstart & ")"
.Range("G17") = "=IF(ISBLANK(LocLabor!C" & tblstart & ")=TRUE, """", LocLabor!C" & tblstart & ")"
End With


'rename pasted buttons, update alttext
With locsht
 .Buttons(bnum).Name = "Button " & bnum
 .Buttons(bnum + 1).Name = "Button " & bnum + 1
 .Buttons(bnum).ShapeRange.AlternativeText = dayint + 1
 .Buttons(bnum + 1).ShapeRange.AlternativeText = dayint + 1
 End With


'lock down sheets
Worksheets("LocLabor").Protect Password:=SuperSecretPW, DrawingObjects:=False, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingRows:=True, _
AllowInsertingRows:=True, AllowDeletingRows:=True, AllowSorting:=True, _
AllowFiltering:=True
Worksheets("LocLabor").EnableSelection = xlUnlockedCells

Worksheets("Labor Sign In Day " & numdays + 1).Protect Password:=SuperSecretPW, DrawingObjects:=False, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingRows:=True, _
AllowInsertingRows:=True, AllowDeletingRows:=True, AllowSorting:=True, _
AllowFiltering:=True
Worksheets("Labor Sign In Day " & numdays + 1).EnableSelection = xlUnlockedCells
ActiveSheet.Buttons(Application.Caller).TopLeftCell.Offset(3, 0).Select

Application.ScreenUpdating = True

End Sub

0 个答案:

没有答案