• 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.

VBA script "bijwerken"

Status
Niet open voor verdere reacties.

moensk

Gebruiker
Lid geworden
23 jun 2013
Berichten
784
Ik heb een lint via "Office RibbonXEditor" die werkt uitstekend
Doch 1 knop krijg in niet werkend in tabblad "Export"
het gaat om de knop "DC Bijwerken"
Hieronder script Ribbon en in bijlage een test bestandje
in tabblad "Data" heb ik 6 cellen geel gemarkeerd die dan in de juiste tabbladen dienen bijgewerkt te worden


Code:
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" onLoad="RibbonOnLoad" >
	<ribbon>
		<tabs>
			<tab id="tabExport" label="Export" insertAfterMso="TabHome">
				<group id="GroupDC    "        label="DC">
					<button id="Import_Data"   label="Import - data"  size="normal" onAction="Importeren"     imageMso = "FileImport"/>
				    <button id="Data_DC"       label="Data - DC"      size="normal" onAction="Data"           imageMso = "GetPowerQueryDataFromExcel"/>
				    <button id="DCbijwerken"   label="DC bijwerken"   size="normal" onAction="Bijwerken"      imageMso = "GetPowerQueryDataFromExcel"/>
				    <button id="LegeRijenRDl"  label="Lege rijen del" size="normal" onAction="Del_rij"        imageMso = "Delete"/>
				    <button id="DC_Export"     label="DC - Export"    size="normal" onAction="Export"         imageMso = "GetPowerQueryDataFromExcel"/>
				    <button id="LeegmakenTabs" label="Leegmaken tabs" size="normal" onAction="Leegmaken"      imageMso = "GetPowerQueryDataFromExcel"/>
				</group> 
				<group id="GroupExport"        label="Export">
					<button id="Aldi"          label="Aldi"           size="normal" onAction="Aldi"           imageMso = "GetPowerQueryDataFromExcel"/>
					<button id="Arop"          label="Arop"           size="normal" onAction="Arop"           imageMso = "GetPowerQueryDataFromExcel"/>
					<button id="Bidfood"       label="Bidfood"        size="normal" onAction="Bidfood"        imageMso = "GetPowerQueryDataFromExcel"/>
					<button id="Borre"         label="Borre"          size="normal" onAction="Borre"          imageMso = "GetPowerQueryDataFromExcel"/>
					<button id="Carrefour"     label="Carrefour"      size="normal" onAction="Carrefour"      imageMso = "GetPowerQueryDataFromExcel"/>
					<button id="Cedicora"      label="Cedicora"       size="normal" onAction="Cedicora"       imageMso = "GetPowerQueryDataFromExcel"/>
					<button id="Colruyt"       label="Colruyt"        size="normal" onAction="Colruyt"        imageMso = "GetPowerQueryDataFromExcel"/>
					<button id="Conway"        label="Conway"         size="normal" onAction="Conway"         imageMso = "GetPowerQueryDataFromExcel"/>
					<button id="Delhaize"      label="Delhaize"       size="normal" onAction="Delhaize"       imageMso = "GetPowerQueryDataFromExcel"/>
					<button id="Dudelange"     label="Dudelange"      size="normal" onAction="Dudelange"      imageMso = "GetPowerQueryDataFromExcel"/>
					<button id="Fiege"         label="Fiege"          size="normal" onAction="Fiege"          imageMso = "GetPowerQueryDataFromExcel"/>
					<button id="Fixmer"        label="Fixmer"         size="normal" onAction="Fixmer"         imageMso = "GetPowerQueryDataFromExcel"/>
					<button id="ITM"           label="ITM"            size="normal" onAction="ITM"            imageMso = "GetPowerQueryDataFromExcel"/>
					<button id="Krefel"        label="Krefel"         size="normal" onAction="Krefel"         imageMso = "GetPowerQueryDataFromExcel"/>
					<button id="Lidl"          label="Lidl"           size="normal" onAction="Lidl"           imageMso = "GetPowerQueryDataFromExcel"/>
					<button id="Match"         label="Match"          size="normal" onAction="Match"          imageMso = "GetPowerQueryDataFromExcel"/>
					<button id="Resuma"        label="Resuma"         size="normal" onAction="Resuma"         imageMso = "GetPowerQueryDataFromExcel"/>
					<button id="Sligro"        label="Sligro"         size="normal" onAction="Sligro"         imageMso = "GetPowerQueryDataFromExcel"/>
					<button id="Superlog"      label="Superlog"       size="normal" onAction="Superlog"       imageMso = "GetPowerQueryDataFromExcel"/>
					<button id="aanmelden"     label="aanmelden"      size="normal" onAction="Aanmelden"      imageMso = "GetPowerQueryDataFromExcel"/>
				</group> 
			</tab>
		</tabs>
	</ribbon>
</customUI>
 

Bijlagen

Gebruik altijd namen die niet kunnen interfereren met de VBA/Excel compiler.

M_Export
M_Aldi
M_Sligro, etc.

Gebruik geen 'Select' of 'Activate' in VBA.
 
De knop doet het prima.
Dus wat gaat er niet zoals gewenst?
 
Kijk eens naar bijgaande versie.
Module1 is sterk ingekort, KopieerNaarExport wordt ook in Module2 gebruikt.

Wat zouden de functies Del_rij en Leegmaken moeten doen?
 

Bijlagen

Laatst bewerkt:
Ahulpje,
Del_rij : om overzichterlijker te maken doet een planner soms in de tabbladen lege rijen invoegen. doch deze wil ik niet exporteren. daarom laat ik hem eerst de lege rijen verwijderen en dan pas "DC-Export" uitvoeren. maar nu ik er over nadenk kan ik die beide scripts wel naar 1 script zetten :)
Leegmaken : is voor s'avonds als ze klaar zijn dan worden de dc tabbladen en export leeggemaakt, klaar voor volgende dag.

Edmoor,
knop werkt, geen idee waarom hij voordien niet werkte, heb hem getest in mijn origineel en nu deed hij het gewoon

enigste omslachtige dat er nu nog is, is in tabblad "data" daar moet ik de filter handmatig op de gewenste datum zetten.
die datum is bepalende voor de andere scripts "Data - DC"
kan ik een invoerveld ergens en dat hij de filter aanstuurt ?
 
Daar kan je Autofilter voor gebruiken op de betreffende kolom.
 
Om het netjes te maken doen planners wel lege rijen tussen voegen in de tabbladen om hun overzicht te bewaren.
als er geen lege rijen tussen gevoegd worden dan werkt onderstaand script "DC bijwerken" doch als ik lege rij invoeg dan krijg ik foutmelding 3001 op rs.find "opdrachtnrummer = ...."

Code:
Public Function UpdateData(Ws As String)
    Dim lngLastRow As Long, lngRow As Long
    Dim rs As Object
    Dim cn As Object
    Set cn = CreateObject("adodb.connection")
    Set rs = CreateObject("adodb.recordset")
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
    rs.Open "Select * From [Data$]", cn, 2, 1, adCmdTable
    With Sheets(Ws)
        lngLastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
        For lngRow = 2 To lngLastRow
            rs.Find "Opdrachtnummer = " & .Range("C" & lngRow), 1
            If Not rs.EOF Then
                .Range("N" & lngRow) = rs.Fields("PP")
                .Range("O" & lngRow) = rs.Fields("LDM")
                .Range("P" & lngRow) = rs.Fields("GEWICHT")
                .Range("Q" & lngRow) = rs.Fields("ZENDINGSTATUS")
                .Range("R" & lngRow) = rs.Fields("WAGEN")
            End If
            rs.movefirst
        Next
    End With
    rs.Close
    Set rs = Nothing
    cn.Close
    Set cn = Nothing
End Function
 
Zo importeer je de gegevens
Code:
With CreateObject("ADODB.Recordset")
   .Open "SELECT * FROM `[COLOR=green]Sheet1[/COLOR]$`", "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=[COLOR=green]G:\OF\voorbeeld.xlsb[/COLOR];Extended Properties=""Excel 12.0 Xml"""
   sheet1.cells(1).copyfromrecordset .datasource
End With

Filteren en sorteren doe je daarna met sort en autofilter
 
Laatst bewerkt:
Bestaat er mogelijkheid om in het lint een datum in te geven of een kalender te zetten waarin datum kan geselecteerd worden.
deze zou ik dan via script met Autofilter kunnen gebruiken
of kan ik enkel via een popup werken om datum te selecteren ?

Bekijk bijlage datumveld.pdf
 
Dat is in beperkte mate mogelijk, zie bijlage.
Hierbij kun je een datum selecteren uit een lijst met datums die opgebouwd is uit de datum van vandaag en een aantal dagen daarvoor en/of daarna.
Als je aan een range van bijvoorbeeld een maand genoeg hebt is de dropdownlijst nog te overzien, wil je uit meerdere maanden of zelfs jaren kunnen kiezen dan wordt de dropdown onhandelbaar.
 

Bijlagen

Ahulpje,
geselecteerde datum is steeds eerst volgende werkdag
die lijst kan ik wel per maand bijwerken, dat is ni zo een groot werk.
 
Is het dan niet veel eenvoudiger om de volgende functie te gebruiken:
Code:
Function EerstvolgendeWerkdag() As Date
     EerstvolgendeWerkdag = Application.WorkDay(Date + 1, 1)
End Function
 
Ahulpje,
zou zeker kunnen doch ik zit nog met de feestdagen, die worden niet gefilterd bij bovenstaande code.
 
Met een lijstje feestdagen op Blad1 in A1:A10

Code:
=WERKDAG(VANDAAG()+1;1;Blad1!A1:A10)
 
Bijgaand script gebruik ik om datum te bepalen voor een autofilter op ander tabblad.
nu filtert hij die exacte datum doch bestaat er mogelijkheid dat hij alles filtert van die datum + alles in toekomst ?

Code:
Sub LosDatum(control As IRibbonControl)
    Range("A1:AZ21645").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
    Sheets("Feestdagen").Range("A1:Z2"), Unique:=False
End Sub
 
Laatst bewerkt:
Dat wordt lastig zonder voorbeeld. Plaats tenminste het werkblad Feestdagen eens hier, maar liever nog het hele document.
 
Op werkblad Feestdagen in cel H2:
Code:
=">=" &  WERKDAG(VANDAAG();1;Feestdagen!A4:A15)
 
Ahulpje
kan u even kijken naar scripts
als ik op knop "delhaize" druk zou hij inhoud vanaf rij 2moeten kopiëren naar tabblad "export"
doch hij kopieert maar 2 regels, de kopregel zou niet mogen mee gekopieerd worden maar dat doet hij wel.
voorbeeld in bijlage
 

Bijlagen

Zie bijlage.
Maar ik zou er toch eens over gaan nadenken of het wel nodig is om iedere "klant" een eigen werkblad te geven. Alles in één werkblad met hier en daar een filtertje maakt het leven een stuk eenvoudiger.
 

Bijlagen

Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan