【发布时间】：2015-10-07 08:08:54
【问题描述】：
我已经完成了我的 VBA，我正在尝试运行它。当我从代码窗口进入并按 F5 时，它会运行，但是当我尝试使用实际工作簿中的按钮时，我得到“无法运行宏。此工作簿中可能没有宏，或者所有宏都可能是禁用。”
'Activating Sheet2 in EMM_Template
Sheets("Sheet2").Activate
'Deleting Column E (Prod RICC)
Sheets("Sheet2").Columns(5).EntireColumn.Delete
'Deleting Row 3 (Title Row)
Sheets("Sheet2").Rows(3).EntireRow.Delete
'Selecting Range
Sheets("Sheet2").Range("A3").CurrentRegion.Select
'Changing Font To Calibri 10
With Sheets("Sheet2").Range("A3").CurrentRegion
With .Font
.Name = "Calibri"
.Size = 10
End With
End With
With Sheets("Sheet2")
For Lrow = 1 To ActiveSheet.UsedRange.Rows.Count
With .Cells(Lrow, "M")
If Not IsError(.Value) Then
If .Value = "FUTURE" Then
.EntireRow.Delete
End If
End If
End With
Next Lrow
End With
'Copying from Sheet2
'Activating/Pasting EMM_ETF
Sheets("Sheet2").Range("A3").CurrentRegion.Copy
Sheets("EMM ETF").Activate
Sheets("EMM ETF").Range("A3").Select
Sheets("EMM ETF").Rows("3:3").Insert shift:=xlDown
'Format Data
Sheets("EMM ETF").Range("A3").CurrentRegion.Select
Range("A3").CurrentRegion.Rows.RowHeight = 12.75
Range("A3").CurrentRegion.Columns.ColumnWidth = 12
Rows("1:1").EntireRow.AutoFit
Rows("2:2").EntireRow.AutoFit
With Sheets("EMM ETF").Rows("2:2").EntireRow
With .Font
.Size = 10
End With
End With
'Deleting 0's from Col FGH
For i = 1 To ActiveSheet.UsedRange.Rows.Count
If Trim((Cells(i, 13).Value)) = "CURNCY" Then
Cells(i, 6).Delete shift:=xlToLeft
Cells(i, 6).Delete shift:=xlToLeft
Cells(i, 6).Delete shift:=xlToLeft
End If
Next i
'Deleting 0's from Col IJK
For i = 1 To ActiveSheet.UsedRange.Rows.Count
If Trim((Cells(i, 13).Value)) = "STOCK" Then
Cells(i, 9).Delete shift:=xlToLeft
Cells(i, 9).Delete shift:=xlToLeft
Cells(i, 9).Delete shift:=xlToLeft
End If
Next i
'Insert Column to for Action Autofill
Sheets("EMM ETF").Range(Range("J3:L3"), Range("J3:L3").End(xlDown)).Select
Sheets("EMM ETF").Range(Range("J3:L3"), Range("J3:L3").End(xlDown)).Cut
Sheets("EMM ETF").Range("K3").Select
ActiveSheet.Paste
'Match Action Rights to Last Comment
Dim Rng As Range, x As Range
With ActiveSheet
Set Rng = .Range("I3:I" & .Range("I" & Rows.Count).End(xlUp).Row)
For Each x In Rng
If InStr(1, x.Text, "No Action", 1) > 0 Then
x.Offset(0, 1).Value = "No Action"
End If
Next x
Set Rng = .Range("I3:I" & .Range("I" & Rows.Count).End(xlUp).Row)
For Each x In Rng
If InStr(1, x.Text, "Rights", 1) > 0 Then
x.Offset(0, 1).Value = "Rights"
End If
Next
Set Rng = .Range("I3:I" & .Range("I" & Rows.Count).End(xlUp).Row)
For Each x In Rng
If InStr(1, x.Text, "Warrant", 1) > 0 Then
x.Offset(0, 1).Value = "Warrant"
End If
Next x
Set Rng = .Range("I3:I" & .Range("I" & Rows.Count).End(xlUp).Row)
For Each x In Rng
If InStr(1, x.Text, "Pinksheet", 1) > 0 Then
x.Offset(0, 1).Value = "Pinksheet"
End If
Next x
Set Rng = .Range("I3:I" & .Range("I" & Rows.Count).End(xlUp).Row)
For Each x In Rng
If InStr(1, x.Text, "Desk", 1) > 0 Then
x.Offset(0, 1).Value = "Desk to adjust"
End If
Next x
Set Rng = .Range("I3:I" & .Range("I" & Rows.Count).End(xlUp).Row)
For Each x In Rng
If InStr(1, x.Text, "Asset", 1) > 0 Then
x.Offset(0, 1).Value = "Asset Servicing"
End If
Next x
Set Rng = .Range("I3:I" & .Range("I" & Rows.Count).End(xlUp).Row)
For Each x In Rng
If InStr(1, x.Text, "Journal", 1) > 0 Then
x.Offset(0, 1).Value = "MO Journal"
End If
Next x
End With
'Detect/Cut/Insert/CCY
Dim CorrectPosition As Integer
CorrectPosition = getCorrectPosition("Ccy")
Call MoveRows("K", "CURNCY", CorrectPosition)
'Detect/Cut/Insert/Foreign
CorrectPosition = getCorrectPosition("Foreign")
Call MoveRows("A", "FRGN3", CorrectPosition)
'Changing Font To Calibri 10
With Sheets("EMM ETF").Range("A3").CurrentRegion
With .Font
.Name = "Calibri"
.Size = 10
End With
End With
'Final Sort
End Sub
Function getCorrectPosition(StringToLookFor As String) As Integer
Dim i As Integer
For i = 3 To ActiveSheet.UsedRange.Rows.Count
If (Cells(i, 1) = StringToLookFor) Then
Exit For
End If
Next
getCorrectPosition = i + 2
End Function
Sub MoveRows(columnName As String, LookupValue As String, positionToPaste As Integer)
With Sheets("EMM ETF")
For Lrow = 2 To ActiveSheet.UsedRange.Rows.Count
With .Cells(Lrow, columnName)
If Not IsError(.Value) Then
If .Value = LookupValue Then
.EntireRow.Cut
Cells(positionToPaste, 1).Select
Selection.Insert shift:=xlDown
Lrow = 1
ElseIf .Value = "" Then
Exit For
End If
End If
End With
Next Lrow
End With
End Sub
【问题讨论】：
-
如果不知道您的代码，很难知道会发生什么。你可以发布你的代码吗？另外，“按钮”是什么意思？您是否在工作表中添加了按钮，或者您的意思是查看->宏，然后从那里运行？另外，宏在哪里是？它是否在该工作簿、您的个人工作簿等的模块中？
-
我同意@BruceWayne！除了他的问题，控件是 ActiveX 还是 Form 控件？
-
嘿@BruceWayne 和 MiguelH -- 所以我有 3 个实际按钮，我添加到工作表中来运行我猜的 3 个不同的 Subs。这些按钮位于工作簿中的工作表上，该工作表还包含宏在其中工作的 3 个工作表。我将在下面发布一些代码以供参考。谢谢大家！
-
'将字体更改为 Calibri 10 With Sheets("Sheet2").Range("A3").CurrentRegion With .Font .Name = "Calibri" .Size = 10 End With End With Sheets( "Sheet2") For Lrow = 1 To ActiveSheet.UsedRange.Rows.Count With .Cells(Lrow, "M") If Not IsError(.Value) Then If .Value = "FUTURE" Then .EntireRow.Delete End If End If以下一个结尾结束于
-
将代码添加到您的原始帖子中（单击“编辑”）然后突出显示，然后单击
{}以格式化为代码。