Melding voorzien indien LKxxx niet in lijst voorkomt

[danny147]

Beste HSV,

Gezocht en gevonden:

    Sheets("Systeem").Select
    Range("WPL_ELE_MEC").Select
    Selection.Copy
    Sheets(mySheetName).Select
    Range("A25").Select
    ActiveSheet.Paste

Vervangen door:

    ThisWorkbook.Sheets("Systeem").Range("WPL_ELE_MEC").Copy Destination:=ThisWorkbook.Sheets(mySheetName).Range("A25")

 

[HSV]

Danny,

:thumb::thumb::thumb::thumb::thumb:

Dit stukje mag je nog verwijderen, maar is niet noodzakelijk hoor.

Destination:=

 

[snb]

Zelfs zo:

Range("WPL_ELE_MEC").Copy Sheets(mySheetName).Range("A25")

 

[danny147]

Beste HSV

Graag zou ik nog een melding willen toevoegen, zie onderstaande maar loopt fout.
Indien cancel dan einde code en range vanaf invullen loopkraan tot einde verwijderen.

                If n > 0 Then
                   twb.Range("A1000").End(xlUp).Offset(1).Resize(n, 15) = arr2
                   n = 0
                  Erase arr2
                Else
                  If MsgBox("Geen opdrachten gevonden voor """ & str & """.", vbQuestion + vbOKCancel, "Data niet gevonden") <> vbOK Then
                  Range("A" & Sheets("Systeem").Range(IBNStart) - 2 & ":" & "R500").ClearContents
                  Exit Sub
                End If
                  End If


       'Next x
    End With
   End With
.Close 0
End With

opmaak

End Sub

 

[HSV]

Wel blijven opletten Danny.
Dat alles staat al in het bestand van #152.

 

[danny147]

Beste HSV,

Begrijp ik, maar heeft toch niks met dit te maken volgens mij ?

Na het ingeven van de loopkraannummer wordt sjabloon IBN weergegeven.
Daarna worden er gegevens opgehaald, indien er geen gegevens zijn moet ik de keuze kunnen maken om de code verder te laten lopen zonder gegevens of alles af te verwijderen vanaf de cel waar de loopkraan begint.

Hopelijk begrijp je het

 

[HSV]

Jouw stuk code is anders dan de code in #152.
Daar staat er al in, als de kraan niet wordt gevonden krijg je daar een msgbox en daarna worden de IBN gegevens weer gewist.

Edit: Daar wil jij dus weer de keuze kunnen maken wel/niet.
Begin met de msgbox twee knoppen te geven (VbyesOk).

laat maar. ik kijk er op later op de dag wel even naar.

 

[HSV]

Zoiets als dit Danny?

 

[danny147]

Beste HSV,

Niet wat ik voor ogen had.
De bedoeling is als ik No zeg dat alles wordt verwijderd vanaf de cel waar de loopkraan staat in dit geval is dit cel A48 of (IBNStart -2) met alles wat eronder staat.
Indien Yes dan code verder laten lopen.

Heb nu geprobeerd met vbYesNo maar doet het niet.

                If n > 0 Then
                   twb.Range("A1000").End(xlUp).Offset(1).Resize(n, 15) = arr2
                   n = 0
                  Erase arr2
                Else
                  If MsgBox("Geen opdrachten gevonden voor """ & str & """." & vbCrLf & "Wil je verder gaan ?", vbYesNo, "Data niet gevonden") = vbNo Then
                  Range("A" & Sheets("Systeem").Range(IBNStart) - 2 & ":" & "R500").ClearContents
'                  TR = False
                  .Parent.Parent.Close 0
                  End If
                  Exit Sub
                End If

 

[HSV]

Het staat in:

Sub VulGegevensLPKIn(control As IRibbonControl)

Druk op de knop "kraan orders" en vul eens LK101 in.

 

[danny147]

Beste HSV,

Op mijn werk werkt het bestandje van jou wel en thuis niet, vandaar dat het niet werkte

Ziet er goed uit, enkel als je door wilt gaan dat vervolg niet uitgevoerd wordt
De groene en de blauwe balk worden niet weergegeven.

 

[HSV]

Het heeft ook geen zin om me twee msgboxen te werken.
Ik heb er ééntje van gemaakt.

Test het maar eens weer.

 

[danny147]

Beste HSV,

Heb mijn versie hier geplaatst.

Wat ik vreemd vind is dat de code voor de eerste keer loopt bij het ingeven van LK100 dat hij dan de melding geeft "geen opdrachten gevonden voor deze loopkraan "LK100" terwijl er juist wel zijn.

Als je nu de rijen van 46 tem 97 verwijderd en je laat dan de code terug lopen geeft hij die melding niet hetgeen dan juist is.

Als je LK101 intypt en je laat de code lopen, bij melding zeg je dan NEE, dan krijg je een foutmelding.

Vindt je dit niet raar ?

 

[HSV]

Beste Danny,

Plaatst de rode regelcode, dan moet dat weer opgelost zijn.

Sub VulGegevensLPKIn(control As IRibbonControl) 'h()
Dim iRowStart As Integer
Dim iRowEinde As Integer
Dim mySheetName As String
Dim i As Variant
[COLOR=#ff0000]Tr = True[/COLOR]

 

[danny147]

Beste HSV,

Mits een kleine aanpassing werkt dit nu perfect.
Het bereik van Rng1 was niet juist.
Kreeg foutmelding op Rng1.Delete (gegevens van BTR en BGE bleven nog staan bij het negeren van LK101)

Is nu geworden.

        With ThisWorkbook.Sheets("Systeem")
           .Range("CHStart").Value = .Range("IBNEinde") + 2
           iRowStart = .Range("CHStart")
           .Range("ColumnHeader").Copy Sheets(mySheetName).Range("A" & iRowStart)
           
        'Set Rng1 = Sheets(mySheetName).Range(rng, Sheets(mySheetName).Range("A" & iRowStart + 3)).Resize(, Columns.Count - 1)
        'Set Rng1 = Rows(rng & ":" & iRowStart + 3)
        End With
      End With
    End With
invoeren_gegevens_LPK
vervolg

[COLOR="#FF0000"]        Range("CHBGEEinde").Value = Sheets(mySheetName).Range("A1000").End(xlUp).row
        iRowEinde = Range("CHBGEEinde")
        Set Rng1 = Rows(rng & ":" & iRowEinde + 2)[/COLOR]
    
 If Tr = False Then
     If MsgBox("Geen opdrachten gevonden voor deze loopkraan """ & str & """" & vbLf & _
     "Wilt u de ""IBN"" gegevens behouden ?", vbInformation + vbYesNo, "LET OP") = vbNo Then
       Rng1.Delete

 

[HSV]

Hallo Danny,

Ik heb het idee dat je gedeeltelijke stukjes code eruit haalt i.p.v. de gehele code over te nemen.
Hier verwijderde het alles en geen foutmelding.

 

[danny147]

Beste HSV,

Tot nu toe loopt alles naar wens bij mij.

Nu het laatste onderdeel:

De gegevens van EXT en BGE
De opmaak van de bestandjes zijn identiek.
Naam bestand EXT is PlanningEXT.xlsm
Naambestand BGE is PlanningBGE.xlsm
Men moet geen rekening houden met aantal personen, gewoon de gegevens overschrijven.

Volgende gegevens moeten gebruik worden in de code:

        Workbooks.Open ThisWorkbook.path & "\PlanningEXT.xlsm"
        With Workbooks("PlanningEXT.xlsm").Sheets("Blad2")
        .AutoFilter 1, ">=" & CLng(twb.Cells(1, 3)), 1, "<=" & CLng(twb.Cells(1, 3))
        .AutoFilter 7, Blad10.Cells(strTwo, 3) & "*"

                            arr2(n, 1) = sn(ii, 3)
                            arr2(n, 2) = sn(ii, 9)
                            arr2(n, 3) = sn(ii, 11)
                            arr2(n, 8) = sn(ii, 5)
                            arr2(n, 11) = sn(ii, 2)
                            arr2(n, 13) = sn(ii, 8)

 

[HSV]

Hallo Danny,

Moet dit via een geheel nieuwe code opgehaald worden?
Zo ja, welke knop hoort daarbij?
Zo nee, aan welke bestaande code moet dit gekoppeld worden?

Het is een .xlsb extensie... zit in die bestanden Vba code?
Waarom kan ik het niet openen in de projectverkenner.

 

[danny147]

Beste HSV,

Weet niet of je de bestaande code voor LPK kan aanpassen ?

Als je bestand gedeeld opheft dan kan men de code zien.

Het is een xlsb versie omdat ik de xlsm versie niet kan uploaden.

Dit komt in het gedeelte "vervolg" zie groen gemarkeerd.

'        [COLOR="#008000"]Hieronder vult men weer gegevens in via volgend bestandje op tabblad 2, locatie is:
'        ChDir "\\Sidmar.be\dfs\Dienst\GROEP\LAD\LPK\Betacel\Projecten"
'        Workbooks.Open Filename:="file:\\Sidmar.be\dfs\Dienst\GROEP\LAD\LPK\Betacel\Projecten\planningEXT.xlsx", ReadOnly:=True
'        Eerst kijkt men naar de datum, dan naar LKXXX en men schrijft de gegevens weg op de juiste plaats.
'        Indien er geen gegevens aanwezig zijn dan melding: "Geen gegevens aanwezig voor Betrouwbaarheidscel" en code verder laten lopen[/COLOR]

 

[HSV]

Je maakt het er niet eenvoudiger op om middenin een code nog weer veranderingen aan te brengen.
Het groene gedeelte staat twee keer in de code "Vervolg".

Waar zou het naar toe geschreven moeten worden.
Op welke rij verwacht je de gegevens.