• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

data wegschrijven naar een extern blad in een specifiek veld plaatsen

Status
Niet open voor verdere reacties.
Perfect nu schrijft ie het weg in Jaarproductie Karren 2024, ik heb meteen hetzelde stuk code bij "Jaarproductie m3 2024" geplaatst.
 
Code: 
Private Sub Worksheet_Activate()
With Sheets("jaarproductie karren 2024")
r = Application.Match(Sheets("Teamleider-productie Dashboard").Range("e37"), .Columns(2), 0)
 End With
ActiveWindow.ScrollRow = r - (8 + Weekday([a1], 2))

End Sub
 
Als ik jaarproduktie karren 2024 open krijg ik als foutmelding in worksheet activate dit stuk code wat niet meer klopt ik kan er nietrs fouts in zien jij ?
ActiveWindow.ScrollRow = r - (8 + Weekday([a1], 2))
 
En welke melding?
 
Bekijk de messagebox, dan wordt het misschien duidelijk.
Code: 
Private Sub Worksheet_Activate()
With Sheets("jaarproductie karren 2024")
    r = Application.Match(Sheets("Teamleider-productie Dashboard").Range("e37"), .Columns(2), 0)
End With
 
If IsNumeric(r) Then
 
    ActiveWindow.ScrollRow = r - (8 + Weekday([a1], 2))
Else
    MsgBox "datum " & Sheets("Teamleider-productie Dashboard").Range("e37") & " bestaat niet in het jaar 2024"
End If

End Sub
 
AD1957 zei:
Bekijk de messagebox, dan wordt het misschien duidelijk.
Code: 
Private Sub Worksheet_Activate()
With Sheets("jaarproductie karren 2024")
    r = Application.Match(Sheets("Teamleider-productie Dashboard").Range("e37"), .Columns(2), 0)
End With
 
If IsNumeric(r) Then
 
    ActiveWindow.ScrollRow = r - (8 + Weekday([a1], 2))
Else
    MsgBox "datum " & Sheets("Teamleider-productie Dashboard").Range("e37") & " bestaat niet in het jaar 2024"
End If

End Sub
Klik om te vergroten...
oeps ja logischdankje :-)
 
de bovenste knop is om de huidige datum date op te slaan, bij de onderste geldt dat voor data van een vergeten dag in het verleden.
in de gele lijst met targets staan de te halen karren per pers die verandert met de dag middag en nachtdienst, en wordt zo weggeschreven als ik het target haal.

Bij de onderste knop kies ik een willekeurige datum als het nou dagdienst is maar de datum die ik noteer lag bv in de nachtdienst kloppen de targets niet hoe los ik dat op ?

Ik heb trouwens van mijn programma voor hier op t forum tabbladen eruit gehaald omdat het programma al te groot wordt, ik ga voor alle toekomstige jaren de databladen moeten vermenigvuldigen lijkt me verstandig om die in een aparte bestand in dezelfde map als het hoofdprogramma op te slaan en naar gaan te verwijzen om te voorkomen dat alles uit de klauwen loopt qua grootte nietwaar ?
hoef ik dan alleen maar deze regel zo aan te passen als in de volgende macro ?
 
Laatst bewerkt door een moderator:
rogersmeets zei:
Bekijk bijlage 374529
de bovenste knop is om de huidige datum date op te slaan, bij de onderste geldt dat voor data van een vergeten dag in het verleden.
in de gele lijst met targets staan de te halen karren per pers die verandert met de dag middag en nachtdienst, en wordt zo weggeschreven als ik het target haal.

Bij de onderste knop kies ik een willekeurige datum als het nou dagdienst is maar de datum die ik noteer lag bv in de nachtdienst kloppen de targets niet hoe los ik dat op ?

Ik heb trouwens jaartallen en dlen van mijn programma voor hier op t forum eruit gehaald omdat het programma al te groot wordt, ik ga voor alle toekomstige jaren de databladen moeten vermenigvuldigen lijkt me verstandig om die in een aparte bestand in dezelfde map als het hoofdprogramma op te slaan en naar gaan te verwijzen om te voorkomen dat alles uit de klauwen loopt qua grootte nietwaar ?
hoef ik dan alleen maar deze regel zo aan te passen als in de volgende macro ?
Klik om te vergroten...
Code: 
Sub Button2_Click()
Set sh = Sheets("Teamleider-Productie Dashboard")
With Sheets("c:/Teamleider-Productie Dashboard ("Jaarproductie Karren " & Year(Date))
 
Voor de eerste vraag:
Zoek een oplossing voor het tijdelijk veranderen van de waarde in cel AS2
aanzet:
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) = "E45" Then
    If IsDate(Target) Then
        Range("AS2") = Target
    Else
        Range("AS2").FormulaR1C1 = "=TODAY()"
    End If
End If
End Sub

en dan:
Code: 
Sub Button3_Click()

Set sh = Sheets("Teamleider-Productie Dashboard")
If IsDate(sh.Range("E45")) Then

    With Sheets("Jaarproductie Karren " & Year(sh.Range("E45")))
      r = Application.Match(sh.Range("e45"), .Columns(2), 0)
      If IsNumeric(r) Then
             .Cells(r, 3).Resize(, 7).Value = sh.Range("f37:l37").Value
    .Cells(r, 11) = sh.Range("N40").Value
    
             For Each cl In .Cells(r, 3).Resize(, 7)
               cl.Interior.ColorIndex = sh.Range("f37").Offset(, y).DisplayFormat.Interior.ColorIndex
                y = y + 1
             Next cl
    
            MsgBox "Data gekopieerd naar aantal karren !", vbInformation, "Copy"
    
      End If
      sh.Range("E45") = ""
    End With
Else
    MsgBox "er is geen datum ingevuld"
    sh.Range("E45") = ""
    
End If

'With Sheets("Jaarproductie m3 " & Year(Date))
'  r = Application.Match(sh.Range("e45"), .Columns(2), 0)
'  If IsNumeric(r) Then
'         .Cells(r, 3).Resize(, 7).Value = sh.Range("f38:m38").Value
'
'         For Each cl In .Cells(r, 3).Resize(, 7)
'           cl.Interior.ColorIndex = sh.Range("f38").Offset(, y).DisplayFormat.Interior.ColorIndex
'            y = y + 1
'            Selection.ClearContents
'            Range("E45").Activate
'         Next cl
'
'        MsgBox "Data gekopieerd naar aantal m3!", vbInformation, "Copy"
'
'
'  End If
'
'End With
End Sub
 
Alllereerst bedankt voor je hulp, ik heb in het bestand in de bijlage gedaan wat je zei, heb in het wit de targets voor de diensten in getallen erbij gezet, alle targets voor dagdienst ingevuld, als datum heb ik 8-1-2024 ingevoerd dat is dagdienst dus zou hij 7 targets moeten wegschrijven met 7 groenen vakjes in
"Jaarproductie Karren 2024" maar zoals je kunt zien allemaal rood en 0 targets.
dat komt omdat hij op nachtdienst staat voor deze week en de targets dan hoger liggen.

bovendien gaat er iets mis bij het wegschrijven van "Jaarproductie m3 2024" het tweede gedeelte van de macro
 
Laatst bewerkt door een moderator:
dit stuk code heb je niet overgenomen in blad Teamleider........
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) = "E45" Then
    If IsDate(Target) Then
        Range("AS2") = Target
    Else
        Range("AS2").FormulaR1C1 = "=TODAY()"
    End If
End If
End Sub

Het wegschrijven naar blad Jaarproductie M3 gaat fout omdat range("As2") al op =Vandaag() is gezet.
probeer het maar eens zo.
Code: 
Sub Button3_Click()

Set sh = Sheets("Teamleider-Productie Dashboard")
If IsDate(sh.range("E45")) Then

    With Sheets("Jaarproductie Karren " & Year(sh.range("E45")))
          r = Application.Match(sh.range("e45"), .Columns(2), 0)
          If IsNumeric(r) Then
                 .Cells(r, 3).Resize(, 7).Value = sh.range("f37:l37").Value
                 .Cells(r, 11) = sh.range("N40").Value
       
                 For Each cl In .Cells(r, 3).Resize(, 7)
                   cl.Interior.ColorIndex = sh.range("f37").Offset(, y).DisplayFormat.Interior.ColorIndex
                    y = y + 1
                 Next cl
       
                MsgBox "Data gekopieerd naar aantal karren !", vbInformation, "Copy"
       
          End If
         
    End With



    With Sheets("Jaarproductie m3 " & Year(sh.range("E45")))
      r = Application.Match(sh.range("e45"), .Columns(2), 0)
      If IsNumeric(r) Then
             .Cells(r, 3).Resize(, 7).Value = sh.range("f38:m38").Value
   
             For Each cl In .Cells(r, 3).Resize(, 7)
               cl.Interior.ColorIndex = sh.range("f38").Offset(, y).DisplayFormat.Interior.ColorIndex
                y = y + 1
                Selection.ClearContents
'                range("E45").Activate
             Next cl
   
            MsgBox "Data gekopieerd naar aantal m3!", vbInformation, "Copy"
   
   
      End If
   
    End With
   
    sh.range("E45") = ""
 Else
    MsgBox "er is geen datum ingevuld"
    sh.range("E45") = ""
   
End If
   

End Sub

p.s. Niet volledig getest, maar volgens mij werkt het nu.
Zelf maar eens kijken waarom het mis ging.
 
ik heb m erin gezet maar begrijp ik nou dat ie de datum op vandaag zet ?
de bedoeling is dat ie met de onderste knop juist een datum buiten vandaag kan opslaan want vandaag doet ie al met de bovenste knop dat werkt, de onderste is om een oude datum de data op te slaan, maar de targets van die datum de juiste dienst te selecteren omdat de targets van de dag minder hoog liggen en van middag ook dan van nacht.

ik heb m nog eens bijgevoegd ik kom er niet meer uit hoe het goed te krijgen, heb gedaan erin wat je zei.
 
Heb je het eigenlijk wel getest ?.
Werkt nu alleen met datums in 2024.
Als je een datum invult in het jaar 2023 gaat het mis, dit omdat er geen bladen jaarproductie 2023 zijn.
De knop opslaan huidige dienst geeft nu dus ook een foutmelding.
 
ik had m zeker getest maar in de uitgeklede versie die hier op hetforum past, niet in het origineel, tis super, en daarmee heb ik zo goed als alle obstakels weggewerkt, met dank aan jou/jullie thanks.
 
rest me nog waar ik deze tread mee begonnen ben het opslaan van het aantal elementen naar een apart blad.
ik heb dat blad nu aangepast zodat het makkelijker wordt om de juiste stenen over te schrijven.


Vak G-H-I zijn samen de maat stenen "100 623 CS20" alleen als er in vak J een karren is ingevoerd dat dan de data van vak G-H-I en L het aantal stenen wordt overgeschreven naar jaarproductie elementen kims.


ik heb nu voor de 3 velden Vak G-H-I die samen de maat stenen "100 623 CS20" zijn 1 vak gemaakt per pers, dat maakt het makelijker voor mij straks een draaitabel te maken van het soort elementen dan waneer deze in drie cellen weer bij elkaar gezocht moet worden, of dat een probleem is weet ik niet.
Per pers zijn er drie vakken op dezelfde datums op het hoofdblad zijn er ook drie kolommen waar drie element soorten per pers kunnen worden ingevuld.
ik voeg het programma met dit blad toe.

je ververs optie werkt niet meer op deze lijst ook is inmiddels de macro voor alles opslaan veranderd, macro 2 en 3.

zou je nog een keer kunnen helpen (hihi) lijkt of ik veel overlaat maar ik werk me uit de naad qua uren om dit programma van de grond te krijgen tis geen gemakszucht.
 
Laatst bewerkt door een moderator:
AD1957 zei:
Zie groene knop "totaal elementen"
Klik om te vergroten...
AD1957 jij bent fantastisch !!!
ik ga m in mijn programma zetten, ik kan het nieuwe jaar met weer een extra database beginnen waaauw !!!
Wat is dat voor een button ik probeer er de macro code uit te halen maar bij rechtermuis klik kom ik er niet in wil hem graag in de andere twee buttons verwerken.

het blad schrijft niet de hoogtemaat kleuren weg dat zorgt voor overzicht kan ik gewoon een macro in het nieuwe tabblad inzetten die de hoogtematen 514 -598- 623- 643 leest en daar sautomatisch een kleur aan meegeeft ?
 
Laatst bewerkt:
Dat cosmetische kun je beter even achterwege laten.
Zorg er eerst voor dat je de code begrijpt.
Anders zal het toepassen in het originele bestand waarschijnlijk weer voor problemen zorgen.
 
AD1957 zei:
Dat cosmetische kun je beter even achterwege laten.
Zorg er eerst voor dat je de code begrijpt.
Anders zal het toepassen in het originele bestand waarschijnlijk weer voor problemen zorgen.
Klik om te vergroten...
met je eens.
Ik weet hoe je in een macro de code vind deze button kan ik niet met rechtermuisklik benaderen ik zie dus de code niet.
1703950691543.png
deze kan ik de benaderen

1703950957298.png
deze niet
 
Laatst bewerkt:
toets Alt+F11

of

Boven in het lint op ontwikkelaars>>>ontwerpmodus
klick rechts op de groene commandbutton>>>programmacode weergeven

Misschien moet je jouw werkgever eens vragen om een cursus VBA, gezien jouw vraag lijkt me dat zeer raadzaam.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan