我有下面的代码在.xlsm文件中可以正常工作,但是当我将代码复制到Personal.xls文件中时,它不再起作用。我搜索了该论坛并找到了类似的主题,但是似乎没有一个主题可以解决我的问题。
我确定您可以看到我的代码正在随机创建一个密码(日志记录为20个字符,但为此我修改了公式以仅显示3个字符)。
Sub Password_Generator()
Application.ScreenUpdating = False
Sheets.Add.Name = "Password"
Range("B1").Value = "A"
Range("B2").Value = "B"
Range("B3").Value = "C"
Range("B4").Value = "D"
Range("B5").Value = "E"
Range("B6").Value = "F"
Range("B7").Value = "G"
Range("B8").Value = "H"
Range("B9").Value = "I"
Range("B10").Value = "J"
Range("B11").Value = "K"
Range("B12").Value = "L"
Range("B13").Value = "M"
Range("B14").Value = "N"
Range("B15").Value = "O"
Range("B16").Value = "P"
Range("B17").Value = "Q"
Range("B18").Value = "R"
Range("B19").Value = "S"
Range("B20").Value = "T"
Range("B21").Value = "U"
Range("B22").Value = "V"
Range("B23").Value = "W"
Range("B24").Value = "X"
Range("B25").Value = "Y"
Range("B26").Value = "Z"
Range("B27").Value = "a"
Range("B28").Value = "b"
Range("B29").Value = "c"
Range("B30").Value = "d"
Range("B31").Value = "e"
Range("B32").Value = "f"
Range("B33").Value = "g"
Range("B34").Value = "h"
Range("B35").Value = "i"
Range("B36").Value = "j"
Range("B37").Value = "k"
Range("B38").Value = "l"
Range("B39").Value = "m"
Range("B40").Value = "n"
Range("B41").Value = "o"
Range("B42").Value = "p"
Range("B43").Value = "q"
Range("B44").Value = "r"
Range("B45").Value = "s"
Range("B46").Value = "t"
Range("B47").Value = "u"
Range("B48").Value = "v"
Range("B49").Value = "w"
Range("B50").Value = "x"
Range("B51").Value = "y"
Range("B52").Value = "z"
Range("B53").Value = "1"
Range("B54").Value = "2"
Range("B55").Value = "3"
Range("B56").Value = "4"
Range("B57").Value = "5"
Range("B58").Value = "6"
Range("B59").Value = "7"
Range("B60").Value = "8"
Range("B61").Value = "9"
Range("B62").Value = "0"
Range("B63").Value = "!"
Range("B64").Value = "£"
Range("B65").Value = "$"
Range("B66").Value = "%"
Range("B67").Value = "&"
Range("B68").Value = "*"
Range("A1").Select
ActiveCell.FormulaR1C1 = "1"
Range("A2").Select
ActiveCell.FormulaR1C1 = "2"
Range("A3").Select
ActiveCell.FormulaR1C1 = "3"
Range("A1:A3").Select
Selection.AutoFill Destination:=Range("A1:A68"), Type:=xlFillDefault
Range("A1:A68").Select
Columns("A:B").Select
Selection.EntireColumn.Hidden = True
Columns("G").Select
Selection.ColumnWidth = 35
Range("G2").Value = "PASSWORD"
Range("G4").Value = "Select F9 to generate a new password"
Range("G3").Formula = "=VLOOKUP(RANDBETWEEN(1,68),A:B,2,0)&VLOOKUP(RANDBETWEEN(1,68),A:B,2,0)&VLOOKUP(RANDBETWEEN(1,68),A:B,2,0)
Range("G2:G4").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Range("G2").Select
Selection.Font.Bold = True
Range("G4").Select
Selection.Font.Italic = True
Selection.Font.Size = 9
Range("G3").Copy
Application.ScreenUpdating = False
End Sub
答案 0 :(得分:0)
您必须指定要在哪个工作簿中添加工作表,并为所有范围指定一个工作簿
Dim wsNew As Worksheet
Set wsNew = ActiveWorkbook.Worksheets.Add
wsNew.Name = "Password"
您可以通过
访问该工作表上的范围wsNew.Range("A1").FormulaR1C1 = "1"
请注意,您应避免使用.Select
,因为这是一种不好的做法(请参见How to avoid using Select in Excel VBA)。
将此技术(指定工作表并删除选择项)应用于每个Range
,Cells
,Columns
,Rows
等对象。
还要注意,您可以通过短得多的循环来减少所有这些Range("B1").Value = "A"
语句:
Const Letters As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890!£$%&*"
Dim iLetter As Long
For iLetter = 1 To Len(Letters)
wsNew.Cells(iLetter, "B").Value = Mid$(Letters, iLetter, 1)
Next iLetter
您最终会得到类似的结果,它应该可以工作:
Sub Password_Generator()
Application.ScreenUpdating = False
Dim wsNew As Worksheet
On Error GoTo ERR_ADDSHEET 'catch error if worksheet exists
Set wsNew = Worksheets.Add
On Error GoTo 0 're-enable error reporting
wsNew.Name = "Password"
Const Letters As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890!£$%&*"
Dim iLetter As Long
For iLetter = 1 To Len(Letters)
wsNew.Cells(iLetter, "B").Value = Mid$(Letters, iLetter, 1)
Next iLetter
With wsNew
.Range("A1").Value = "1"
.Range("A2").Value = "2"
.Range("A3").Value = "3"
.Range("A1:A3").AutoFill Destination:=.Range("A1:A" & Len(Letters)), Type:=xlFillDefault
.Columns("A:B").EntireColumn.Hidden = True
.Columns("G").ColumnWidth = 35
.Range("G2").Value = "PASSWORD"
.Range("G4").Value = "Select F9 to generate a new password"
.Range("G3").Formula = "=VLOOKUP(RANDBETWEEN(1,68),A:B,2,0)&VLOOKUP(RANDBETWEEN(1,68),A:B,2,0)&VLOOKUP(RANDBETWEEN(1,68),A:B,2,0)"
.Range("G2:G4").HorizontalAlignment = xlCenter
.Range("G2:G4").VerticalAlignment = xlCenter
.Range("G2").Font.Bold = True
.Range("G4").Font.Italic = True
.Range("G4").Font.Size = 9
.Range("G3").Copy
End With
ERR_ADDSHEET:
Application.ScreenUpdating = True
If Err.Number > 0 Then MsgBox "Worksheet could not be added.", vbCritical
End Sub