pages created and started formatting
This commit is contained in:
3
.vscode/settings.json
vendored
Normal file
3
.vscode/settings.json
vendored
Normal file
@@ -0,0 +1,3 @@
|
||||
{
|
||||
"editor.snippetSuggestions": "top",
|
||||
}
|
||||
7
Main.bas
7
Main.bas
@@ -1,6 +1,5 @@
|
||||
Attribute VB_Name = "Main"
|
||||
Sub main()
|
||||
'get the av data based on what is in cell b24
|
||||
msgbox "The av to grab are" + sheets("Setup Data").range("B24").value
|
||||
End Sub
|
||||
sub main ()
|
||||
debug.print "just here"
|
||||
end sub
|
||||
|
||||
|
||||
@@ -6,5 +6,5 @@ This is a standard psi based off the dayton abbott one
|
||||
XLWINGS should be installed to run this and update the macro
|
||||
once installed run
|
||||
```
|
||||
xlwings vba edit .\MacroTemplate2.0.xlsm
|
||||
xlwings vba edit .\StandardPSI.xlsm
|
||||
```
|
||||
BIN
StandardPSI.xlsm
BIN
StandardPSI.xlsm
Binary file not shown.
125
createSheets.bas
125
createSheets.bas
@@ -1,50 +1,97 @@
|
||||
Attribute VB_Name = "createSheets"
|
||||
Sub CreateSheetIfNotExist()
|
||||
Sub createOrUpdateArticles()
|
||||
Dim cellValue As String
|
||||
Dim articles As Variant
|
||||
Dim ws As Worksheet
|
||||
Dim keepSheets As Object
|
||||
|
||||
Dim cellValue As String
|
||||
Dim sheetNames As Variant
|
||||
Dim i As Long
|
||||
Dim ws As Worksheet
|
||||
Dim sheetExists As Boolean
|
||||
' Initialize the collection for sheets to keep
|
||||
Set keepSheets = CreateObject("Scripting.Dictionary")
|
||||
|
||||
' Articles seperated by a ,
|
||||
cellValue = ThisWorkbook.Sheets("Setup Data").Range("B24").Value
|
||||
' Static sheets to keep
|
||||
keepSheets.Add "Setup Data", True
|
||||
'keepSheets.Add "8oz data", True
|
||||
'keepSheets.Add "10oz data", True
|
||||
'keepSheets.Add "COA Needs", True
|
||||
'keepSheets.Add "Approved COA's", True
|
||||
'keepSheets.Add "Forecast", True
|
||||
'keepSheets.Add "Truck list", True
|
||||
'keepSheets.Add "planningNumbers", True
|
||||
'keepSheets.Add "productionNumbers", True
|
||||
'keepSheets.Add "stockNumbers", True
|
||||
'keepSheets.Add "Delivered", True
|
||||
|
||||
' Split the comma-separated string into an array of sheet names
|
||||
sheetNames = Split(cellValue, ",")
|
||||
Debug.Print "Value in the cell: " & cellValue
|
||||
'get the av data based on what is in cell b24
|
||||
|
||||
' Split the comma-separated string into an array of sheet names
|
||||
sheetNames = Split(cellValue, ",")
|
||||
Debug.Print "Result of Split function:"
|
||||
For i = LBound(sheetNames) To UBound(sheetNames)
|
||||
Debug.Print " Index " & i & ": """ & sheetNames(i) & """"
|
||||
Next i
|
||||
cellValue = ThisWorkbook.Sheets("Setup Data").Range("B4").Value
|
||||
articles = Split(cellValue, ",")
|
||||
count = UBound(articles) - LBound(articles) + 1
|
||||
|
||||
' Loop through each potential sheet name
|
||||
For i = LBound(sheetNames) To UBound(sheetNames)
|
||||
Dim newSheetName As String
|
||||
newSheetName = Trim(sheetNames(i)) ' Remove any leading/trailing spaces
|
||||
' clear the table so when we run the setup it only shows us clean data.
|
||||
sheets("Setup Data").range("A19:G" & 19 + count + 20).ClearContents
|
||||
|
||||
sheetExists = False
|
||||
' Check if the sheet already exists
|
||||
For Each ws In ThisWorkbook.Sheets
|
||||
If ws.Name = newSheetName Then
|
||||
sheetExists = True
|
||||
Exit For
|
||||
End If
|
||||
Next ws
|
||||
' create the table start for the av we will be utlizeing.
|
||||
dim i as Integer
|
||||
|
||||
' If the sheet doesn't exist, create it
|
||||
If Not sheetExists Then
|
||||
On Error Resume Next ' In case there's an issue creating the sheet
|
||||
ThisWorkbook.Sheets.Add After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
|
||||
ActiveSheet.Name = newSheetName
|
||||
On Error GoTo 0 ' Resume normal error handling
|
||||
Debug.Print "Sheet '" & newSheetName & "' created."
|
||||
For i = LBound(articles) To UBound(articles)
|
||||
' Get a trimmed version of the article name for easier use
|
||||
sheetName = "Article " & Trim(articles(i))
|
||||
keepSheets.Add sheetName, True
|
||||
' Debug output for tracking
|
||||
Debug.Print "Article to be placed is: " & Trim(articles(i))
|
||||
|
||||
' Place the articles in the Setup Data Sheet at specific range
|
||||
'ThisWorkbook.Sheets("Setup Data").Range("A" & 19 + i).Value = Trim(articles(i))
|
||||
|
||||
' Initialize the ws object to Nothing before checking existence
|
||||
Set ws = Nothing
|
||||
|
||||
' Attempt to set ws to an existing sheet with the desired name
|
||||
On Error Resume Next
|
||||
Set ws = ThisWorkbook.Sheets(sheetName)
|
||||
On Error GoTo 0
|
||||
|
||||
' If the sheet doesn't exist, add it
|
||||
If ws Is Nothing Then
|
||||
On Error Resume Next
|
||||
Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
|
||||
ws.Name = sheetName
|
||||
call formatArticleSheet.formatArticleSheet(Trim(articles(i)), sheetName)
|
||||
On Error GoTo 0
|
||||
Else
|
||||
Debug.Print "Sheet '" & newSheetName & "' already exists."
|
||||
ws.Visible = xlSheetVisible
|
||||
End If
|
||||
Next i
|
||||
|
||||
End Sub
|
||||
Next i
|
||||
|
||||
' Clean up the sheets so we only ever have the correct data.
|
||||
For Each ws In ThisWorkbook.Worksheets
|
||||
wsName = ws.Name
|
||||
If keepSheets.exists(wsName) Then
|
||||
Debug.Print wsName & " is inside the keepSheets Dictionary"
|
||||
Else
|
||||
Debug.Print wsName & " is not inside the keepSheets Dictionary"
|
||||
Application.DisplayAlerts = False
|
||||
' Uncomment to delete or hide based on your preference
|
||||
ws.Delete
|
||||
' ws.Visible = xlSheetHidden
|
||||
Application.DisplayAlerts = True
|
||||
End If
|
||||
Next ws
|
||||
|
||||
call getArticleData.getArticleData
|
||||
Exit Sub
|
||||
|
||||
ErrorHandler:
|
||||
' Handle specific error for connection issues
|
||||
If Err.Number = -2147012867 Then
|
||||
MsgBox "Please make sure you are connected to vpn, and or make sure the server is online.", vbCritical
|
||||
ElseIf Err.Number = -2147012894 Then
|
||||
MsgBox "Server is not reachable please try again later."
|
||||
|
||||
' Handle other errors
|
||||
MsgBox "An unexpected error occurred: " & Err.Description, vbCritical
|
||||
End If
|
||||
|
||||
|
||||
End Sub
|
||||
14
formatArticleSheet.bas
Normal file
14
formatArticleSheet.bas
Normal file
@@ -0,0 +1,14 @@
|
||||
Attribute VB_Name = "formatArticleSheet"
|
||||
Sub formatArticleSheet(ByVal article As String, ByVal sheet as string)
|
||||
'
|
||||
'This will format the sheet based on the og psi, all formulas will be rebuilt everytime you click update articles
|
||||
'
|
||||
'
|
||||
'
|
||||
'
|
||||
'
|
||||
'
|
||||
|
||||
sheets(sheet).range("A2").value = "AV"
|
||||
sheets(sheet).range(article)
|
||||
End Sub
|
||||
74
getArticleData.bas
Normal file
74
getArticleData.bas
Normal file
@@ -0,0 +1,74 @@
|
||||
Attribute VB_Name = "getArticleData"
|
||||
public sub getArticleData()
|
||||
Dim port as string
|
||||
Dim req As New WinHttpRequest
|
||||
Dim statusMessage as string
|
||||
dim url as string
|
||||
Dim json As Object
|
||||
Dim dataArray As Object
|
||||
dim headerRow as range
|
||||
dim h as Integer
|
||||
Dim cellValue As Variant
|
||||
Dim rowIndex As Integer
|
||||
|
||||
' The server and url stuff will change once we move to the new version of lst running on go in iis
|
||||
server = Sheets("Setup Data").Range("B5").Value
|
||||
token = Sheets("Setup Data").Range("B6").Value
|
||||
articles = Sheets("Setup Data").Range("B4").value
|
||||
|
||||
port = 3000
|
||||
if token = "usiow2" then
|
||||
port = 3001
|
||||
end if
|
||||
url = "http://" & server & ":" &port &"/api/datamart/psiarticledata?avs=" & articles
|
||||
debug.print url
|
||||
|
||||
req.Open "GET", url, False
|
||||
|
||||
req.Send
|
||||
|
||||
jsonResponse = req.ResponseText
|
||||
|
||||
Set json = JsonConverter.ParseJson(jsonResponse)
|
||||
If req.Status <> 200 Then
|
||||
'"Message: " & req.StatusText & vbNewLine &
|
||||
message = "StatusCode " & req.Status & vbNewLine & _
|
||||
"Message : " & json("message")
|
||||
MsgBox message, vbInformation, "Server Error"
|
||||
|
||||
End If
|
||||
|
||||
|
||||
Set dataArray = json("data")
|
||||
Set headerRow = Sheets("Setup Data").Range("A18")
|
||||
|
||||
If req.Status = 200 Then
|
||||
' add the headers
|
||||
h = 1
|
||||
for each Item in dataArray(1).Keys
|
||||
if Item <> "Id" then
|
||||
headerRow.Cells(1, h).value = Item
|
||||
h = h +1
|
||||
end if
|
||||
next Item
|
||||
|
||||
rowIndex = 19 'starts at this row
|
||||
|
||||
For j = 1 To dataArray.Count
|
||||
For x = 1 To h
|
||||
|
||||
cellValue = dataArray(j)(headerRow.Cells(1, x).Value)
|
||||
Debug.Print "Header: " & dataArray(j)(headerRow.Cells(1, x).Value)
|
||||
|
||||
|
||||
If VarType(cellValue) = vbString Then
|
||||
Sheets("Setup Data").Cells(rowIndex, x).Value = "'" & cellValue ' Prefixing with apostrophe forces Excel to treat it as text
|
||||
Else
|
||||
Sheets("Setup Data").Cells(rowIndex, x).Value = cellValue
|
||||
End If
|
||||
Next x
|
||||
rowIndex = rowIndex + 1 ' Move to the next row
|
||||
Next j
|
||||
|
||||
end if
|
||||
end sub
|
||||
Reference in New Issue
Block a user