Sample vba code

Sample code used in schTechLIB. The code is for transforming the stepped wind loading into a uniform load.

---

Option Explicit

#Const MyDebugOn = 0

'Determine equivalent UDL for each slope
'for stepped distribution along doubly pitched
'frame when alpha < 10
'eq UDL based on distributing total load on rafter along length

Function equivUDL0(alpha As Double, He As Double, _
                   BldSpan As Double, BldLen As Double, _
                   roofplane As Integer) As Double
                      
  Dim ht As Double
  Dim dwe(5) As Double
  Dim d As Double
  Dim ratio As Double
  Dim udl(5) As Double
  Dim Cp(5) As Double
  Dim loadEdge(5) As Double
  Dim halfwdth As Double
  Dim rafterlen As Double
  Dim sumudl1 As Double, sumudl2 As Double
  Dim i As Integer
  Dim J As Integer
  Dim k As Integer
  
    
  halfwdth = BldSpan / 2
  rafterlen = halfwdth / Cos(ToRadians(alpha))
  ht = He + halfwdth * Tan(ToRadians(alpha))
  k = halfwdth / He
  
  
  '{i=0} 0.5h
  '{i=1}   1h
  '{i=2}   2h
  '{i=3}   3h
  '{i=4}  >3h = bldspan
  '{i=5}  halfwdth
  
  dwe(0) = 0.5 * He
  Cp(0) = Get_Cpe_UD(0, alpha, He, ht, BldSpan, BldLen, dwe(0))
  
  dwe(4) = BldSpan
  Cp(4) = Get_Cpe_UD(0, alpha, He, ht, BldSpan, BldLen, dwe(4))
  
  dwe(5) = halfwdth
  Cp(5) = Get_Cpe_UD(0, alpha, He, ht, BldSpan, BldLen, dwe(5))
  
  For i = 1 To 3
    dwe(i) = i * He
    Cp(i) = Get_Cpe_UD(0, alpha, He, ht, BldSpan, BldLen, dwe(i))
  Next i
  
  J = 0
  k = 0
  For i = 0 To 5
    If dwe(i) < halfwdth Then
       loadEdge(i) = dwe(i) / Cos(ToRadians(alpha))
       If i = 0 Then
         udl(i) = loadEdge(i) * Cp(i)
       Else
         udl(i) = (loadEdge(i) - loadEdge(i - 1)) * Cp(i)
       End If
       J = i
    ElseIf dwe(i) = halfwdth Then
       loadEdge(i) = dwe(i) / Cos(ToRadians(alpha))
       udl(i) = (loadEdge(i) - loadEdge(J)) * Cp(i)
    ElseIf dwe(i) = BldSpan Then
       If k <> 0 Then 'building assumed to greater than 0.5h wide
         loadEdge(i) = (BldSpan - dwe(k)) / Cos(ToRadians(alpha))
         udl(i) = loadEdge(i) * Cp(i)
       Else
         loadEdge(i) = rafterlen
         udl(i) = loadEdge(i) * Cp(i)
       End If
    Else
       If i = J + 1 Then
         loadEdge(i) = (BldSpan - dwe(i)) / Cos(ToRadians(alpha))
         udl(i) = (rafterlen - loadEdge(i)) * Cp(i)
       Else
         loadEdge(i) = (BldSpan - dwe(i)) / Cos(ToRadians(alpha))
         udl(i) = (loadEdge(i - 1) - loadEdge(i)) * Cp(i)
       End If
       k = i
    End If
    'Debug.Print i; dwe(i); cp(i); loadEdge(i); udl(i)
  Next i
  
  'Debug.Print "rafter 1: ..."
  sumudl1 = 0
  For i = 0 To J
    sumudl1 = sumudl1 + udl(i)
    'Debug.Print udl(i)
  Next i
  'Debug.Print udl(5)
  sumudl1 = (sumudl1 + udl(5)) / rafterlen
  
  'Debug.Print "rafter 2: ..."
  sumudl2 = 0
  For i = J + 1 To 3
    sumudl2 = sumudl2 + udl(i)
    'Debug.Print udl(i)
  Next i
  'Debug.Print udl(4)
  sumudl2 = (sumudl2 + udl(4)) / rafterlen
  
  If roofplane = 1 Then
    equivUDL0 = sumudl1
  ElseIf roofplane = 2 Then
    equivUDL0 = sumudl2
  End If

End Function


'-------------
'GABLE ROOF
'-------------
'Determine equivalent UDL for each slope
'for stepped distribution along doubly pitched
'frame when alpha < 10
'eq UDL based on BM due to load on rafter equal to BM for UDL
Function equivUDL0m(alpha As Double, He As Double, _
                   BldSpan As Double, BldLen As Double, _
                   roofplane As Integer, BMBasis As Boolean) As Double
                      
  Dim ht As Double
  Dim dwe(5) As Double
  Dim Cp(5) As Double
  Dim loadEdge(5) As Double
  Dim udl(1 To 5) As Double
  
  Dim ndx(5) As Integer
  
  Dim w(1 To 5) As Double
  Dim a(1 To 5) As Double
  Dim b(1 To 5) As Double
  
  Dim d As Double
  Dim ratio As Double
  
  Dim halfwdth As Double
  Dim L As Double
  Dim sumudl1 As Double, sumudl2 As Double
  
  Dim i As Integer
  Dim J As Integer
  Dim k As Integer
  Dim n As Integer
  
  Dim temp As Double
  Dim udl2 As Double
    
    
  'Debug.Print "eq UDL version  2 ..."
  halfwdth = BldSpan / 2
  'Debug.Print "Half width = "; halfwdth
  
  L = halfwdth / Cos(ToRadians(alpha))
  ht = He + halfwdth * Tan(ToRadians(alpha))
      
  
  For i = 1 To 5
    a(i) = 0
    b(i) = 0
    w(i) = 0
  Next i
  
  '{i=0} 0.5h
  '{i=1}   1h
  '{i=2}   2h
  '{i=3}   3h
  '{i=4}  halfwdth
  '{i=5}  >3h = bldspan
 
  'Determine distance from Windward Edge
  'to far side of load region
  dwe(0) = 0.5 * He
  For i = 1 To 3
    dwe(i) = i * He
  Next i
  dwe(4) = halfwdth
  dwe(5) = BldSpan
  
  
  'Insert halfwdth in position of correct ascending order
  i = 0
  Do While dwe(i) < halfwdth And i <= 3
    i = i + 1
  Loop
  k = i
  
  ndx(5) = 5
  For i = 0 To 4
    If i = k Then
      ndx(i) = 4
    ElseIf i < k Then
      ndx(i) = i
    Else
      ndx(i) = i - 1
    End If
  Next i
  
  'Determine Cp
  'Debug.Print "dwe, cp"
  For i = 0 To 5
    Cp(i) = Get_Cpe_UD(0, alpha, He, ht, BldSpan, BldLen, dwe(ndx(i)))
    'Debug.Print dwe(ndx(i)), cp(i)
  Next i
  
  
  'Determine distance "a" to start of load
  If roofplane = 1 Then
    a(1) = 0
    b(1) = dwe(ndx(0)) / Cos(ToRadians(alpha))
    w(1) = Cp(0)
    
    i = 2
    Do While dwe(ndx(i - 2)) < halfwdth And i <= 5
      a(i) = dwe(ndx(i - 2)) / Cos(ToRadians(alpha))
      b(i) = (dwe(ndx(i - 1)) - dwe(ndx(i - 2))) / Cos(ToRadians(alpha))
      w(i) = Cp(i - 1)
      i = i + 1
    Loop
    n = i - 1
'    Debug.Print "n = "; n
    
'    Debug.Print "a:b:w"
'    For i = 1 To 5
'      Debug.Print i, a(i), b(i), w(i)
'    Next i
  
 
  ElseIf roofplane = 2 Then
 
   
    i = 1
    J = k
    Do
      If halfwdth <= dwe(ndx(J)) And dwe(ndx(J)) <= BldSpan Then
         If i = 1 Then
            a(1) = 0
            b(1) = (halfwdth - (BldSpan - dwe(ndx(J + 1)))) / Cos(ToRadians(alpha))
            w(1) = Cp(J)
         Else
            a(i) = (halfwdth - (BldSpan - dwe(ndx(J)))) / Cos(ToRadians(alpha))
            b(i) = (dwe(ndx(J + 1)) - dwe(ndx(J))) / Cos(ToRadians(alpha))
            w(i) = Cp(J + 1)
         End If
         'Debug.Print i, j
      End If
      i = i + 1
      J = J + 1
    Loop Until i > 5 Or J > 4
    n = i - 1
    'Debug.Print "n = "; n
    
'    Debug.Print "a:b:w"
'    For i = 1 To 5
'      Debug.Print i; a(i); b(i); w(i)
'    Next i
    
  End If
   
  For i = 1 To n
    udl(i) = w(i) * b(i)
    'Debug.Print w(i); b(i); udl(i)
  Next i
 
  sumudl1 = 0
  For i = 1 To n
    sumudl1 = sumudl1 + udl(i)
  Next i

  sumudl1 = sumudl1 / L
  
  If BMBasis Then
   udl2 = eq_udl1(n, w, a, b, L)
   'Debug.Print "eq udl BM basis : ", udl2
   equivUDL0m = udl2
  Else
   equivUDL0m = sumudl1
  End If
  
End Function

---

Looks like need something which can automatically format, syntax highlight the vba code. Alternatively may have to post the code elsewhere.

---

Found a syntax highlighter here. Also found this, but didn't like the idea of referencing unknown javascript modules. As far I could tell the first method just generated html code from the source code provided, but I needed to edit slightly to post it here.