vba code voor waarschuwing verlopen contracten bij openen werkmap

Status
Niet open voor verdere reacties.
I

IngeJ

Gebruiker
Lid geworden
23 jun 2016
Berichten
72
Haai!

Dit is de eerste keer dat ik hier een vraag post, dus vergeef me als ik iets niet goed doe..... ;)

Ik heb een excelbestand met personeelsgegevens, waaronder contractdata etc. Nu kreeg ik de vraag of er bij opening van het bestand een popup kon verschijnen met contracten die gaan verlopen. Hiervoor heb ik in jullie topics onderstaande vba codes gevonden. Ik krijg het alleen niet voor elkaar dat ie dat doet als je het bestand opent....

Code: 
Sub Workbook_Open()
  Dim UR As Range, cConst As Range, cForm As Range, KolDatums As Range, c As Range, Tekst As String, verschil As Integer, Lresponse As Variant
  With Sheets("actief")                                'in dit werkblad
    Set UR = .UsedRange                                    'beperken tot usedrange
    On Error Resume Next
    Set cConst = UR.Offset(, Columns("U").Column - UR.Column).SpecialCells(xlConstants, xlNumbers)  'alle vaste getallen in kolom U
    Set cForm = UR.Offset(, Columns("U").Column - UR.Column).SpecialCells(xlFormulas, xlNumbers)  'alle berekende getallen (via formules) in kolom U
    Set KolDatums = Intersect(.Columns("U"), Union(IIf(cConst Is Nothing, .Range("A1"), cConst), IIf(cForm Is Nothing, .Range("A1"), cForm)))  'alle getallen in kolom F
    If KolDatums Is Nothing Then
      MsgBox "er zijn geen datums in kolom U"
    Else
      For Each c In KolDatums.Cells                        '1 voor 1 alle getallen aflopen
        If IsDate(c) Then                                  'is het een datum
          verschil = c.Value - Date
          Select Case verschil
            Case -14 To 14                                    'binnen de 14 dagen aflopen
              Tekst = Tekst & "Het contract van " & c.Offset(, -20).Value & c.Offset(, -19).Value & c.Offset(, -18).Value & " verloopt over " & verschil & " dagen." & vbLf
              End Select
        End If
      Next
    End If
  End With
  If Tekst <> "" Then Lresponse = MsgBox(Tekst, vbCritical, "Let op!")
 End Sub


PS ik probeer mezelf vba te leren, maar tot nu toe is het vooral een kwestie van kopieren en plakken uit jullie forum ;)
 
Welkom bij HelpMij :). Kun je een voorbeeldje meeposten, dat werkt wat makkelijker.
 
Thnx Octafish!

Dit is het (uitgeklede) bestand, de betreffende vba staat in Module 3.
Het bestand heeft een wachtwoord: PietjePuk


Alvast bedankt!
 

Bijlagen

  • Test database Inge popup 23 juni Helpmij.xlsm
    70,5 KB · Weergaven: 40
Code: 
Sub Workbook_Open()
  on error resume next
  sn= Sheets("actief").columns(21)
  x=Sheets("actief").columns(21).specialcells(2,1).count

  if err.number=0 then
    for j=1 to ubound(sn)
      if isdate(sn(j,1) then
        y=datediff("d",date,sn(j,1))
        if y <14 then c00 = c00 & "Het contract van " & Sheets("actief").cells(j,1) & Sheets("actief").cells(j,2) & Sheets("actief").cells(j,3) & " verloopt over " & y " dagen." & vbLf
      End If
    Next

    If c00 <> "" Then MsgBox c00, vbCritical
  End If
End Sub
 
Laatst bewerkt:
snb zei:
Code: 
Sub Workbook_Open()
  on error resume next
  sn= Sheets("actief").columns(21)
  x=Sheets("actief").columns(21).specialcells(2,1).count

  if err.number=0 then
    for j=1 to ubound(sn)
      if isdate(sn(j,1) then
        y=datediff("d",date,sn(j,1))
        if y <14 then c00 = c00 & "Het contract van " & Sheets("actief").cells(j,1) & Sheets("actief").cells(j,2) & Sheets("actief").cells(j,3) & " verloopt over " & y " dagen." & vbLf
      End If
    Next

    If c00 <> "" Then MsgBox c00, vbCritical
  End If
End Sub
Klik om te vergroten...

Thnx SNB,
Ik heb jouw code in mijn bestand geplakt, maar dan krijg ik de volgende melding:

Capture.JPG
 
IngeJ zei:
Haai!

Dit is de eerste keer dat ik hier een vraag post, dus vergeef me als ik iets niet goed doe..... ;)

Ik heb een excelbestand met personeelsgegevens, waaronder contractdata etc. Nu kreeg ik de vraag of er bij opening van het bestand een popup kon verschijnen met contracten die gaan verlopen. Hiervoor heb ik in jullie topics onderstaande vba codes gevonden. Ik krijg het alleen niet voor elkaar dat ie dat doet als je het bestand opent....

Code: 
Sub Workbook_Open()
  Dim UR As Range, cConst As Range, cForm As Range, KolDatums As Range, c As Range, Tekst As String, verschil As Integer, Lresponse As Variant
  With Sheets("actief")                                'in dit werkblad
    Set UR = .UsedRange                                    'beperken tot usedrange
    On Error Resume Next
    Set cConst = UR.Offset(, Columns("U").Column - UR.Column).SpecialCells(xlConstants, xlNumbers)  'alle vaste getallen in kolom U
    Set cForm = UR.Offset(, Columns("U").Column - UR.Column).SpecialCells(xlFormulas, xlNumbers)  'alle berekende getallen (via formules) in kolom U
    Set KolDatums = Intersect(.Columns("U"), Union(IIf(cConst Is Nothing, .Range("A1"), cConst), IIf(cForm Is Nothing, .Range("A1"), cForm)))  'alle getallen in kolom F
    If KolDatums Is Nothing Then
      MsgBox "er zijn geen datums in kolom U"
    Else
      For Each c In KolDatums.Cells                        '1 voor 1 alle getallen aflopen
        If IsDate(c) Then                                  'is het een datum
          verschil = c.Value - Date
          Select Case verschil
            Case -14 To 14                                    'binnen de 14 dagen aflopen
              Tekst = Tekst & "Het contract van " & c.Offset(, -20).Value & c.Offset(, -19).Value & c.Offset(, -18).Value & " verloopt over " & verschil & " dagen." & vbLf
              End Select
        End If
      Next
    End If
  End With
  If Tekst <> "" Then Lresponse = MsgBox(Tekst, vbCritical, "Let op!")
 End Sub


PS ik probeer mezelf vba te leren, maar tot nu toe is het vooral een kwestie van kopieren en plakken uit jullie forum ;)
Klik om te vergroten...


Misschien nog ff ter verduidelijking, als ik de code test in het vba scherm dmv "Sub/userform uitvoeren" doet ie het wel
 
IngeJ zei:
Thnx SNB,
Ik heb jouw code in mijn bestand geplakt, maar dan krijg ik de volgende melding:

Bekijk bijlage 272951
Klik om te vergroten...

Dan zul je ergens wat haakjes of een ampersand bij moeten plaatsen.
Dus: ananlyseer de code grondig, dan komt het vanzelf goed.
 
Laatst bewerkt:
snb zei:
Dan zul je ergens wat haakjes of een ampersand bij moeten plaatsen.
Dus: ananlyseer de code grondig, dan komt het vanzelf goed.
Klik om te vergroten...

Bedankt voor de tip SNB, maar ik vrees dat voor mij nog veel te moeilijk is. Ik heb geen echte kennis van VBA (hoop er wel een opleiding voor te kunnen doen ooit), dus tot nu toe heb ik mijn bestand eigenlijk opgebouwd door zoeken op jullie forum en dan knippen en plakken en aanpassen.

Maar in jouw code zie ik niet wat er verkeerd gaat, sorry
 
Hallo Inge,

Als je de code van module3 selecteert en knipt, daarna module3 verwijderd en de code plakt in ThisWorkbook is je probleem opgelost.

Met vriendelijke groet, Corania17.
 
corania17 zei:
Hallo Inge,

Als je de code van module3 selecteert en knipt, daarna module3 verwijderd en de code plakt in ThisWorkbook is je probleem opgelost.

Met vriendelijke groet, Corania17.
Klik om te vergroten...

Dank je wel Corania17!!! Het is nu gelukt, echt super!!!!
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan