Sub AddNewGuidance()
Dim Last_Row As Long
'Code below is to ensure I always have a new number to help with assigning unique names to cells containing guidance
Static I As Long
I = I 1 Now()
Dim wsl As Worksheet
Set wsl = Worksheets(1)
Dim ws As Worksheet
Set ws = Worksheets(2)
Dim NewName As String 'This is simply the string to be paired with "I's" value to aid in creating uniquely named cells
NewName = "Guidance" & "" & I 'Concatenation of string and value of I to acquire unique name
ws.Activate 'Activating the sheet where the guidance on how to perform the checklist task will be located
Last_Row = Cells(Rows.Count, 1).End(xlUp).Offset(7, 0).Select
With Selection 'Selecting the 7th row below the last cell with text
.HorizontalAlignment = xlLeft 'There are 6 spaces added to add separation between text
.VerticalAlignment = xlTop 'We format this cell now
.WrapText = True
.Font.Size = 10
End With
ActiveCell.Rows("1:1").EntireRow.Select ' We now select the row that the selected cell is in
Selection.RowHeight = 150 'We now format the row that the selected cell is in
ActiveCell.Offset(1, 0).Range("A1:A6").Select '6 rows below newly formatted cell are selected
Selection.Style = "Accent3" 'These 6 rows are now given a gray color
ActiveCell.Offset(-1, 0).Range("A1").Select 'The newly formatted cell is selected again
ActiveWorkbook.Names.Add NewName, RefersTo:=Selection 'Newly formatted/ selected cell now given a name
wsl.Activate 'The worksheet actually containing checklist questions is selected
Dim Rng As Range
For Each Rng In Range("A16:A150") 'All questions are contained in this range
If Rng.Value = "" Then Rng.Offset(0, 1).Select 'We want to loop through and find new blank cell
'We then want to select the cell to the right of that blank cell
Exit For 'We want to exit the loop once that is done
Next Rng
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
"'General List Guidance'!Last_Row", TextToDisplay:="LINK"
End Sub
最后，我們想在清單表上獲取我們新選擇的空白單元格并將其鏈接到我們之前在“ws”表上創建的新創建/命名的指導單元格我不確定如何參考它，因為指導“名稱" 將永遠是新的，我似乎無法使用我的Last_Row變數作為范圍來鏈接回它
注：“ws”等同于名為“General List Guidance”的表格。我在嘗試參考它時使用了它的全名，因為我不確定如何合并ws此處的“暗淡”名稱。現在，創建了一個鏈接，但是當我單擊它時我得到一個無效的參考。任何幫助將不勝感激。
uj5u.com熱心網友回復：
嘗試這個：
Sub AddNewGuidance()
Static I As Long
Dim wsl As Worksheet, ws As Worksheet, wb As Workbook
Dim NewName As String, rng As Range, c As Range
'Code below is to ensure I always have a new number to help
' with assigning unique names to cells containing guidance
I = I 1 Now()
NewName = "Guidance" & I
Set wb = ActiveWorkbook 'or ThisWorkbook if that's where this code is running
Set wsl = wb.Worksheets(1)
Set ws = wb.Worksheets(2)
'Selecting the 7th row below the last cell with text
Set rng = ws.Cells(Rows.Count, 1).End(xlUp).Offset(7, 0)
With rng
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = True
.Font.Size = 10
.EntireRow.RowHeight = 150
.Offset(1, 0).Resize(6).Style = "Accent3" 'gray color
End With
wb.Names.Add NewName, RefersTo:=rng 'Newly formatted/ selected cell now given a name
For Each c In wsl.Range("A16:A150").Cells
If Len(c.Value) = 0 Then
wsl.Hyperlinks.Add Anchor:=c.Offset(0, 1), Address:="", _
SubAddress:=NewName, TextToDisplay:="LINK"
Exit For 'done searching
End If
Next c
End Sub
請注意，在使用它們之前幾乎不需要選擇范圍/作業表 - 這只是宏記錄器創建代碼的方式的產物。
轉載請註明出處，本文鏈接：https://www.uj5u.com/caozuo/519616.html
標籤：擅长vba句法超链接