VBA start niet, werkt wel.

[Coowly]

Hoi,

ik krijg de VBA code niet handmatig gestart of gecontroleerd.
ik merk wel dat de code op de achtergrond mee blijft draaien omdat alle gegevens wel bijgewerkt worden.

ik krijg wanneer ik handmatig de code wil doorlopen het volgende scherm in de bijlage.

ik snap er helemaal niets van, ik hoop dat jullie me kunnen helpen.
waarschijnlijk doe ik iets verkeerd, of heb ik een verkeerde instelling ingesteld.

 

[edmoor]

Zet je cursor in een procedure (Sub) voordat je op F5 drukt of op Run klikt. Als de cursor buiten een Sub staat verschijnt inderdaad het schermpje met macro's. Wel ook even een breakpoint aangeven.

 

[Coowly]

Hooi,

Edmoor, ik heb het geprobeerd. het werkt echter niet. ik blijf hetzelfde schermpje krijgen.
ook als ik mijn cursor in de (public) sub zet en een breakpoint aangeef.

 

[edmoor]

Wat doe je precies om die Sub te activeren?

 

[Coowly]

ik probeer op run, het groene driehoekje te drukken, of door F5 in te drukken.

 

[edmoor]

Als het echt een Sub is en niet een Function dan zou ik het zo ook niet weten. Volgens mij doe je dan alles goed. Misschien dat iemand anders idee heeft.

 

[Coowly]

Zit het misschien in de code?
ik heb hem hieronder even aangegeven.

Public Sub BijwerkenAssemblageUren(orderpos As String, startdatum As Date, einddatum As Date, gemaakteuren As Integer)
  If gemaakteuren > 0 Then
  Dim startkolom As Integer
  Dim eindkolom As Integer
  Dim kolom As Integer
  Worksheets("Planning").Select
    For kolom = 2 To 365
      If Cells(kolom, 2).Value = startdatum Then
        startkolom = c.Column
        eindkolom = startkolom + (einddatum - startdatum)
        Exit For
      End If
    Next kolom
  End If
  For i = startkolom To eindkolom
    For j = 4 To 42
      If Cells(i, j).Value = orderpos Then
        Cells(i, j).Interior.Color = 50
      End If
    Next j
  Next i
End Sub

Public Function TotaalGeplandeUrenPerBereik(bereik As Range)
  Dim somuren As Integer
  somuren = 0
  For Each c In bereik.Cells
    Select Case True
      Case Left(c.Value, 1) = "R"
        somuren = somuren + 4
      Case Left(c.Value, 1) = "K"
        somuren = somuren + 4
      Case Left(c.Value, 1) = "F"
        somuren = somuren + 4
      Case Left(c.Value, 1) = "G"
        somuren = somuren + 4
      Case Len(c.Value) = 7 Or Len(c.Value) = 8
        somuren = somuren + 4
      Case Else
    End Select
  Next
  TotaalGeplandeUrenPerBereik = somuren
End Function

Public Function TotaalGeplandeUrenKoeltechniekPerBereik(bereik As Range)
  Dim somuren As Integer
  somuren = 0
  For Each c In bereik.Cells
    If Left(c.Value, 1) = "K" Then
        somuren = somuren + 4
    End If
  Next
  TotaalGeplandeUrenKoeltechniekPerBereik = somuren
End Function

Public Function TotaalGeplandeUrenRegeltechniekPerBereik(bereik As Range)
  Dim somuren As Integer
  somuren = 0
  For Each c In bereik.Cells
    If Left(c.Value, 1) = "R" Then
        somuren = somuren + 4
    End If
  Next
  TotaalGeplandeUrenRegeltechniekPerBereik = somuren
End Function

Public Function TotaalGeplandeUrenFitwerkPerBereik(bereik As Range)
  Dim somuren As Integer
  somuren = 0
  For Each c In bereik.Cells
    If Left(c.Value, 1) = "F" Then
        somuren = somuren + 4
    End If
  Next
  TotaalGeplandeUrenFitwerkPerBereik = somuren
End Function

Public Function TotaalGeplandeUrenGereserveerdPerBereik(bereik As Range)
  Dim somuren As Integer
  somuren = 0
  For Each c In bereik.Cells
    If Left(c.Value, 1) = "G" Then
        somuren = somuren + 4
    End If
  Next
  TotaalGeplandeUrenGereserveerdPerBereik = somuren
End Function

Public Function TotaalGeplandeUrenAfwezigPerBereik(bereik As Range)
  Dim somuren As Integer
  somuren = 0
  For Each c In bereik.Cells
   If LCase(c.Value) = "afw" Then
        somuren = somuren + 4
    End If
  Next
  TotaalGeplandeUrenAfwezigPerBereik = somuren
End Function

Public Function TotaalGeplandeUrenAssemblagePerBereik(bereik As Range)
  Dim somuren As Integer
    somuren = 0
  For Each c In bereik.Cells
    If (Len(c.Value) = 7 Or Len(c.Value) = 8 Or Left(c.Value, 1) = "K" Or Left(c.Value, 1) = "F") And Not (Left(c.Value, 1) = "G" Or Left(c.Value, 1) = "R") Then
        somuren = somuren + 4
    End If
  Next
  TotaalGeplandeUrenAssemblagePerBereik = somuren
End Function

Public Function GetAHUStatus(order As String, bereikSoort As Range, bereikStart As Range, bereikStop As Range) As String
  Dim c As Excel.Range
  Dim ahutype As String
  Dim ahuStart As Boolean
  Dim ahuStop As Boolean
  ahutype = ""
  ahuStart = False
  ahuStop = False
  If Left(order, 1) = "F" Or Left(order, 1) = "R" Or Left(order, 1) = "K" Then
    order = Mid(order, 2, 10)
  End If
  For Each c In bereikSoort.Cells
    If c.Value = order Then
      ahutype = Worksheets("Ordernummers").Cells(c.Row, 2).Value
      Exit For
    End If
  Next
  If ahutype <> "" Then
    For Each c In bereikStart.Cells
      If Not c.Value = Empty Then
        If c.Value = order Then
        'MsgBox Worksheets("Act status SAP").Cells(c.Row, 7).Value
          If Worksheets("Act status SAP").Cells(c.Row, 7).Value > 0 Then
            ahuStart = True
          End If
          Exit For
        End If
      End If
    Next
    For Each c In bereikStop.Cells
      If Not c.Value = Empty Then
        If c.Value = order Then
          ahuStop = True
          Exit For
        End If
      End If
    Next
    If ahuStop = True Then
      GetAHUStatus = ahutype & "Stop"
    Else
      If ahuStart = True Then
        GetAHUStatus = ahutype & "Start"
      Else
        GetAHUStatus = ahutype
      End If
    End If
  End If
End Function

 

[edmoor]

Het is wel een sub die parameters vereist. Als je die los start worden deze niet meegegeven.

 

[Coowly]

pff... dat was het inderdaad. Hoe simpel kan het af en toe zijn.

Heel erg bedankt!

 

[edmoor]

Ok dan