comment ne pas appeler une fonction "private function" dans un de mes sub main.
J'ai une macro qui fait du tri et de la mise en page, j'aimerais qu'elle continue la mise ne page et arrete le tri, mais qu'elle arrete la mise en page, or les deux fonctions qui font le tri sont des private function.
J'ai une macro qui fait du tri et de la mise en page, j'aimerais qu'elle continue la mise ne page et arrete le tri, mais qu'elle arrete la mise en page, or les deux fonctions qui font le tri sont des private function.
Code:
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'~~~~~~~~~~~~~Macro to process GCC Violation Report~~~~~~~~~~~~~~
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'***********Violations without Justification for specified Head of Credit**********
Sub Main1()
'***Variables***
Dim GCCReport As Workbook 'Workbook of report from GCC
Dim row_count As Integer 'no of rows written
'Delete data written in last import
Workbooks("GCC Violation Report Filter MacroTEST.xls").Worksheets("Start").Range("D32").ClearContents
Workbooks("GCC Violation Report Filter MacroTEST.xls").Worksheets("Sheet2").Range("B4:Q23000").Delete
'opens dialog box to choose report
Filename = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls), *.xls", Title:="Please select a file")
If Filename = False Then
' They pressed Cancel
MsgBox "Stopping because you did not select a file"
Exit Sub
Else
Workbooks.Open (Filename)
Set GCCReport = ActiveWorkbook
w_rows = DataExtract
GCCReport.Close
End If
MsgBox "Data Import has finished"
Workbooks("GCC Violation Report Filter MacroTEST.xls").Worksheets(2).Activate
row_count = RowCount
With Workbooks("GCC Violation Report Filter MacroTEST.xls").Worksheets(2)
'Set Column Width
.Columns("A").ColumnWidth = 0
.Columns("B").ColumnWidth = 10
.Columns("C").ColumnWidth = 10
.Columns("D").ColumnWidth = 15
.Columns("E").ColumnWidth = 15
.Columns("F").ColumnWidth = 15
.Columns("G").ColumnWidth = 25
.Columns("H").ColumnWidth = 15
.Columns("I").ColumnWidth = 2
.Columns("J:L").ColumnWidth = 4
.Columns("J:L").HorizontalAlignment = xlCenter
.Columns("M").ColumnWidth = 4
.Columns("N").ColumnWidth = 25
.Columns("O").ColumnWidth = 20
.Columns("P").ColumnWidth = 7
'Set Row Height
.Rows("4:10000").AutoFit
'Set Borders
.Range(Worksheets("Sheet2").Cells(4, 1), Worksheets("Sheet2").Cells(row_count, 17)).Borders.Weight = xlHairline
.Range(Worksheets("Sheet2").Cells(4, 1), Worksheets("Sheet2").Cells(row_count, 17)).Borders.Color = RGB(0, 0, 0)
.Range(Worksheets("Sheet2").Cells(4, 1), Worksheets("Sheet2").Cells(row_count, 17)).Borders.LineStyle = xlContinuous
' .Range(Worksheets("Sheet2").Cells(4, 1), Worksheets("Sheet2").Cells(row_count, 17)).Font.FontStyle = "Tahoma"
' .Range(Worksheets("Sheet2").Cells(4, 1), Worksheets("Sheet2").Cells(row_count, 17)).Font.Size = 10
.Range("A3:Q3").Borders.LineStyle = xlContinuous
.Range("A3:Q3").Borders.Weight = xlHairline
.Range("A3:Q3").Borders.Color = RGB(0, 0, 0)
End With
Call ColorUPC(4, row_count, 17, 5)
Call SeperateUPC(4, row_count, 17, 5, False)
Call DeleteJust(False, row_count)
Call PrintSetup(65, 2)
End Sub
'~~~~~Function to scan (active) Worksheet~~~~~
'returns row no in which entry was found if succesful, 0 else
'~~~~~Arguments~~~~~
'SearchValue the value you are looking for
'row_start row in which scan starts
'wb_to_scan Workbook which is scanned
'row_max maximal no of rows to be scanned
Private Function Scan(SearchValue, row_start As Integer, Optional wb_to_scan As Workbook, Optional row_max As Integer = 500) As Integer
'Column variable
Dim j As Integer
'sets column to search
'4 means Head for the credit
j = 4
'Loop Counter
Dim i As Integer
i = row_start
'Loop which scans the rows
Do
Dim Search1 As String
Search1 = SearchValue
Test1 = Worksheets("Sheet1").Cells(i, j).Value2
'MsgBox Test1 & " " & VarType(Test1) & " " & VarType(SearchValue)
If Test1 = Search1 Then
Scan = i
Exit Do
End If
If row_max < i Then
Scan = 0
Exit Do
End If
i = i + 1
Loop
End Function
'~~~~~Function to Extract data~~~~~
'returns nothing
'Uses scan and write function defined above to write data to Risky Names which matches reference Data from GCC Report
'~~~~~Arguments~~~~~
'None
Private Function DataExtract(Optional write_sheet As Integer = 2, Optional wb_to_search As Workbook) As Integer
Dim start_scan As Integer 'start_scan specifies in which row to start search
Dim row_found As Integer 'no of row in which data was found
Dim n As Integer 'Set column of reference data
n = 1 'default is 1, means BB ID
Dim m As Integer 'Loop Counter
m = 2 'row from which reference data comparison is started
Dim writecount As Integer 'Counts no of row written to "Risky Names"
writecount = 4 'row to start writing
Dim colorcode As Boolean 'variable which helps define background color to differentiate UPCs
'*****Set reference value which is looked up in GCC Report I*****
'This Loop searches for rows with choosen Head of Credit Name
search_for = Workbooks("GCC Violation Report Filter MacroTEST.xls").Worksheets("Start").Range("D9").Value2
start_scan = 4
'Actual data search is done in this loop
Do
'Scan Worksheet for data to retrieve
row_found = Scan(search_for, start_scan, wb_to_search)
'Gebe Zeile an in welcher Daten gefunden wurden
If row_found <> 0 Then
'MsgBox "Entry is in row " & row_found
Call Write_Data(row_found, writecount, write_sheet)
Workbooks("GCC Violation Report Filter MacroTEST.xls").Worksheets("Start").Range("D32").Value = "Succesful"
start_scan = row_found + 1
writecount = writecount + 1
Else
If start_scan = 6 Then
Workbooks("GCC Violation Report Filter MacroTEST.xls").Worksheets("Start").Range("D32").Value = "Not Succesful"
'MsgBox "Value not found in file"
End If
End If
Loop While (row_found <> 0)
'*****Set reference value which is looked up in GCC Report II*****
'This loop extracts rows which have no data for col Head of Credit but data for col Issuer
start_scan = 4
'Actual data search is done in this loop
Do
If Worksheets("Sheet1").Cells(start_scan, 3).Value = " " And Worksheets("Sheet1").Cells(start_scan, 6).Value <> 0 And Worksheets("Sheet1").Cells(start_scan, 7).Value <> "SENSEC_OTH" Then
Call Write_Data(start_scan, writecount)
writecount = writecount + 1
End If
start_scan = start_scan + 1
Loop While (start_scan < 500)
DataExtract = writecount
End Function
'~~~~~Function to Write data~~~~~
'writes entire row of specified cell to file "Risky Names"returns String
'Uses scan and write function defined above to write data to Risky Names which matches reference Data from GCC Report
'~~~~~Arguments~~~~~
'copy_row specifies row to copy
'write_row specifies row into which is written
Private Sub Write_Data(copy_row As Integer, write_row As Integer, Optional sheet As Integer = 2, Optional set_color As Boolean)
'Copy from GCC Report and write data to Risky Names
Worksheets("Sheet1").Cells(copy_row, 1).EntireRow.Copy (Workbooks("GCC Violation Report Filter MacroTEST.xls").Worksheets(sheet).Cells(write_row, 1))
'With Workbooks("GCC Violation Report Filter MacroTEST.xls").Worksheets(2).Range(Workbooks("GCC Violation Report Filter MacroTEST.xls").Worksheets(2).Cells(write_row, 1), Workbooks("GCC Violation Report Filter MacroTEST.xls").Worksheets(2).Cells(write_row, 17))
' .Borders.LineStyle = xlContinuous
' .Borders.Weight = xlHairline
' .Borders.Color = RGB(0, 0, 0)
' .Font.FontStyle = "Tahoma"
' .Font.Size = 10
'End With
'Workbooks("GCC Violation Report Filter MacroTEST.xls").Worksheets(2).Cells(write_row, 8).Font.Bold = True
If set_color = False Then
'Workbooks("GCC Violation Report Filter MacroTEST.xls").Worksheets("Sheet1").Range(Cells(write_row, 1), Cells(write_row, 36)).Interior.color = RGB(92, 172, 238)
End If
End Sub
(coupe et colle les 3 lignes dans une procédure Sub)
