带有3个相互链接的命令按钮的vba宏

问题描述 投票：0回答：1

如何通过三个命令按钮应用宏功能？我尝试使用下面的代码..但是返回了应用于不同工作表的宏。

cmd button1：浏览主原始数据文件。

cmd button2：主文件的vlookup数据文件。

cmd button3：在来自cmd button1的主原始数据文件上运行宏功能。

您的想法将大有帮助。 

Option Explicit
Sub currentZOE3()
'declare variable to store path

Dim Get_Path As String

    Dim fileExplorer As FileDialog
    Set fileExplorer = Application.FileDialog(msoFileDialogFilePicker)

    'To allow or disable to multi select
    fileExplorer.AllowMultiSelect = False

    With fileExplorer

If .Show <> 0 Then
Get_Path = .SelectedItems(1)
End If
Worksheets("sheet1").Cells(3, 4).Value = Get_Path

End With

End Sub
Sub lastweekZOE3()

'declare variable to store path

Dim Get_Path As String

    Dim fileExplorer As FileDialog
    Set fileExplorer = Application.FileDialog(msoFileDialogFilePicker)

    'To allow or disable to multi select
    fileExplorer.AllowMultiSelect = False

    With fileExplorer

If .Show <> 0 Then
Get_Path = .SelectedItems(1)
End If
Worksheets("sheet1").Cells(5, 4).Value = Get_Path

End With

End Sub

Sub Macro4()
'
' Macro4 Macro
'

'
Cells.Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Font
        .Name = "Calibri"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Rows("1:1").Select
    Selection.Font.Bold = True
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 13
    Columns("N:N").Select
    Selection.TextToColumns Destination:=Range("N1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
'
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 12
    Columns("Q:S").Select
    Selection.Insert Shift:=xlToRight
    Range("Q1") = "Concantenate"
    Range("R1") = "Delivery Plan"
    Range("S1") = "Last Week Comments"
    Range("Q2").Select
    ActiveCell.FormulaR1C1 = "=RC[-16]&RC[-9]&RC[-7]"
    Range("S2").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],'[Last Week.xlsx]Sheet1'!C1:C2,2,0)"
    Range("R2").Select
    ActiveCell.FormulaR1C1 = _
        "=IFS(RC22=""YBWR"",""What"",ISNUMBER(RC25),""Fully Delivered"",RC19=""Billable Only"",""BILLABLE ONLY"",AND(ISBLANK(RC25),NOT(ISBLANK(RC27))),""Under shipment"",AND(ISBLANK(RC25),ISBLANK(RC27),ISNUMBER(RC14)),""Under packing"",AND(ISBLANK(RC25),ISBLANK(RC27),ISBLANK(RC14)),TEXT(WEEKNUM(RC23),""W00""))"
    Range("P3").Select
    Selection.End(xlDown).Select
    Range("Q8833:S8833").Select
    Range(Selection, Selection.End(xlUp)).Select
    Selection.FillDown
    Cells.Select
    Range("Q8833").Activate
    Selection.Columns.AutoFit

    With Cells
    .FormatConditions.Add Type:=xlExpression, Formula1:= _
      "=($R1=""What"")"
    With .FormatConditions(.FormatConditions.Count)
        .SetFirstPriority
        With .Interior
            .PatternColorIndex = xlAutomatic
            .Color = 12173758
            .TintAndShade = 0
        End With
        StopIfTrue = False
    End With
     End With

     With Cells
    .FormatConditions.Add Type:=xlExpression, Formula1:= _
      "=($R1=""Fully Delivered"")"
    With .FormatConditions(.FormatConditions.Count)
        .SetFirstPriority
        With .Interior
            .PatternColorIndex = xlAutomatic
            .Color = 5691552
            .TintAndShade = 0
        End With
        StopIfTrue = False
    End With
     End With

     With Cells
    .FormatConditions.Add Type:=xlExpression, Formula1:= _
      "=($R1=""under shipment"")"
    With .FormatConditions(.FormatConditions.Count)
        .SetFirstPriority
        With .Interior
            .PatternColorIndex = xlAutomatic
            .Color = 3774674
            .TintAndShade = 0
        End With
        StopIfTrue = False
    End With
     End With

     With Cells
    .FormatConditions.Add Type:=xlExpression, Formula1:= _
      "=($R1=""under packing"")"
    With .FormatConditions(.FormatConditions.Count)
        .SetFirstPriority
        With .Interior
            .PatternColorIndex = xlAutomatic
            .Color = 15793920
            .TintAndShade = 0
        End With
        StopIfTrue = False
    End With
     End With

    Sheets(Array("Sheet2", "Sheet3")).Select
    Sheets("Sheet3").Activate
    Application.DisplayAlerts = False
    ActiveWindow.SelectedSheets.Delete

        Range("A1").Select
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add2 Key:= _
        Range("A1:A8837"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveSheet.Range("$A$1:$BE$8837").AutoFilter Field:=1

    'Declare Variables
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long
Dim pvtfield As PivotField

On Error Resume Next
Application.DisplayAlerts = False
Worksheets("PivotTable").Delete
Sheets.Add Before:=ActiveSheet
ActiveSheet.Name = "PivotTable"
Application.DisplayAlerts = True
Set PSheet = Worksheets("PivotTable")
Set DSheet = Worksheets("Sheet1")

'Define Data Range
LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol)


'Define Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _
TableName:="PivotTable")

'Insert Blank Pivot Table
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(1, 1), TableName:="PivotTable")

'Insert Row Fields
With ActiveSheet.PivotTables("PivotTable").PivotFields("Sold to name")
.Orientation = xlRowField
.Position = 1
End With

With ActiveSheet.PivotTables("PivotTable").PivotFields("Sales Document")
.Orientation = xlRowField
.Position = 2
End With

With ActiveSheet.PivotTables("PivotTable").PivotFields("Customer purchase order number")
.Orientation = xlRowField
.Position = 3
End With

'Insert Column Fields
With ActiveSheet.PivotTables("PivotTable").PivotFields("Delivery Plan")
.Orientation = xlColumnField
.Position = 1
End With

'Insert Data Field
With ActiveSheet.PivotTables("PivotTable").PivotFields("SO Net value")
.Orientation = xlDataField
.Position = 1
.Function = xlSum
.NumberFormat = "#,##0"
.Name = " Sum SO Net value "
End With

'classic and expand/collapse button removal

Range("C7").Select
    With ActiveSheet.PivotTables("PivotTable")
        .InGridDropZones = True
        .RowAxisLayout xlTabularRow
    End With
    Range("B4").Select
    ActiveSheet.PivotTables("PivotTable").ShowDrillIndicators = False


'Format Pivot
TableActiveSheet.PivotTables("PivotTable").ShowTableStyleRowStripes = TrueActiveSheet.PivotTables("PivotTable").TableStyle2 = "PivotStyleMedium9"




End Sub
excel vba excel-vba vlookup commandbutton
1个回答
0
投票

一旦使用FileDialog方法获得文件的路径。您可以使用以下功能打开excel并更新其工作表的内容。

Dim updWb As Workbook, wSheet As Worksheet
Set updWb = Workbooks.Open("<path of the workbook to be updated>")
Set wSheet = updWb.Sheets("<sheet-name> or <sheet-index>")
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.