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

afronden datalabel

Status
Niet open voor verdere reacties.
Code:
Sub Print_Grafiek_1_3_5()
   With Sheets("grafieken")
      .Range("A32:A64,A94:A124").EntireRow.Hidden = True        'verberg grafieken 2 en 4
      With .PageSetup                                           '1 en ander juist zetten
         .PrintArea = "$A$1:$N$155"                             'printbereik
         .LeftMargin = 0                                        'alle margins extreem op 0 zetten, aanpassen indien gewenst
         .RightMargin = 0
         .TopMargin = 0
         .BottomMargin = 0
         .HeaderMargin = 0
         .FooterMargin = 0
         .Orientation = xlPortrait                              'staand afdrukken

         .Zoom = False                                          'niet met de schaal werken
         .FitToPagesWide = 1                                    'exact op 1 pagina in de breedte
         .FitToPagesTall = 1                                    'en in de lengte

         .CenterHorizontally = True                             'horizontaal in het midden
         .CenterVertically = True                               'vertikaal in het midden

      End With
      .PrintPreview                                             'printvoorbeeld

      .Cells.EntireRow.Hidden = False                           'rijen terug zichtbaar maken = grafiek 2 en 4 terug tonen
   End With
End Sub
 
Ik zal de code bestuderen want het is wel de bedoeling dat alle grafieken uitgeprint worden maar soms willen ze er vijf op 1 pagina en soms geeft het meer informatie als er maar 1 grafiek op op 1 pagina staat.
 
Ik heb de versie van #39 uitgebreid getest maar op 1 of andere manier gaan de y-as labels van meetpunt 2 niet goed.
Als ik bijvoorbeeld de data van meetpunt 2 vervang door de data van meetpunt 4 dan gaat het mis, ook als ik gewoon andere getallen invul komen er alleen labels tot net onder het midden van de as.
 
hopelijk werkt het met deze extra regel (vrijgeven van de primaire eenheid van de Y-as)
Code:
Sub Grafiek_Aanpassen()
     Dim DInt, X9(), Y9()
     With Chrt

          With .Axes(xlValue, xlPrimary)
               mijnmin = Application.Min(kl, g - 4 * sd)        'je minimum
               mijnmax = Application.Max(gr, g + 4 * sd)        'je maximum
               Delta = (mijnmax - mijnmin) / 6                  'deel het verschil door 6
               edelta0 = -Right(Format(Delta, "0E+00"), 3)
               edelta = WorksheetFunction.Power(10, Right(Format(Delta, "0E+00"), 3))     'tot zoveelste macht van 10 afronden straks
               .MinimumScale = Application.WorksheetFunction.Floor_Math(mijnmin, edelta)     'mijnmin naar beneden afronden
               .MaximumScale = Application.WorksheetFunction.Ceiling_Math(mijnmax, edelta)     'mijnmax naar boven afronden
               ymin = .MinimumScale
             [COLOR="#FF0000"][SIZE=3][B]  .MajorUnitIsAuto = True                          'primaire eenheid Y-as automatisch kiezen
           [/B][/SIZE][/COLOR]    DInt = .MajorUnit
 
Dit werkt perfect. Bedankt.

Nu komen de echt moeilijke items. Op het moment dat ik in een geselecteerde grafiek op een meetpunt klik moet er een verticale marker lijn komen te staan met de meetgegevens in een kader naast de grafiek. Dat kader wil ik maken met een formulier maar ik loop al vast met die markerlijn. Het zou moeten kunnen want als ik met de muis boven een meetpunt ga hangen dan krijg ik de gegevens wel te zien in een kadertje. De opzet wordt dan dat rechts naast de grafiek een kader komt met processtatistieken met daar onder een kader met de meetpunt gegevens.
 

Bijlagen

  • afronden numberformat v2.0.xlsm
    303,9 KB · Weergaven: 18
dan eerst de moeilijkste of toch de meest uitdagende helft van de vraag, het verzamelen van de gegevens van het aangeklikte punt.
In een klassemodule worden de nodige gegevens verzamelt in de array MouseDownArr, die je dan verder in het programma kan gebruiken.

Het werkt ook pas vanaf je het, hierboven door jou vermeldde, klein kadertje met die puntgegevens ziet verschijnen als je met de muis boven dat punt hangt.
Dan klik je op de muis.
Zie module "ModuleGrafiekenEvents".
 

Bijlagen

  • afronden numberformat v2.0.xlsm
    310,5 KB · Weergaven: 22
Laatst bewerkt:
Wauw dat is snel. Het is de bedoeling dat er twee vaste kaders komen waarvan het onderste kader gevuld met de meetgegevens van het geselecteerde punt. De print opties komen dan te vervallen. Per blad krijg je dan 1 grafiek met daarnaast de twee kaders. Ik wou dat met formulieren doen, maar dat hoeft misschien niet.
Ik ga ermee aan de slag.
 
Zoiets zou het dan kunnen worden, maar ik weet niet of het helemaal handig is op deze manier of toch een Formulier gebruiken
 

Bijlagen

  • afronden numberformat v2.1.xlsm
    317,3 KB · Weergaven: 20
ik was zelf aan het stoeien, dus post ik eerst mijn oplossing en kijk zo meteen naar jouw versie.

OK, ik zie wat je wil.
Ik wacht even af, tot je vragen hebt.
 

Bijlagen

  • afronden numberformat v2.0.xlsm
    316,5 KB · Weergaven: 20
Laatst bewerkt:
De markerlijn is precies wat ik bedoel en de meetgegevens dan in het onderste kader rechts van de grafiek. Na selectie van een meetpunt is het de bedoeling dat je ook met de pijltjestoetsen een punt links of rechts van het geselecteerde punt kunt selecteren.
 
Laatst bewerkt:
Dat met die pijltjes ...
 

Bijlagen

  • afronden numberformat v2.1.xlsm
    323,6 KB · Weergaven: 19
De markerlijn werkt alleen als ik een punt selecteer worden alle punten geselecteerd, die selectie gaat pas weg als ik elders in de grafiek klik. De pijltjes werken niet. Morgen ga ik het bestuderen. Heel blij met de hulp.
 
- na het kiezen van een punt wordt die markeerlijn aangemaakt en nu wordt er gesprongen naar de "topleftcell" zodat de serie niet meer geselecteerd blijft.
- de pijltjes werken inderdaad niet. Ik kan wel detecteren dat je met de muis heen en weer of op en neer gaat, maar ik heb daar geen verdere actie aan gehangen. Het is toch eenvoudiger om zelf een vorig of een volgend punt te klikken ?
- in die tabel vanaf Q1 geef ik weer welk punt er bij welke grafiek geselecteerd is.
Van de 1e 2 grafieken heb ik al de label en de x- en y-waarde toegevoegd aan je kadertje, bij de volgende nog niet.
- soms zie ik een keer iets eigenaardigs gebeuren met de "plotarea" van de grafiek, maar als ik eens heen en weer wip naar tabblad "data" en terug, dan is alles weer het oude.
Even afwachten of dat hindert.
 

Bijlagen

  • afronden numberformat v2.1.xlsm
    328,9 KB · Weergaven: 17
Laatst bewerkt:
na wat gestoei met het pogen tot het kiezen van een punt links of rechts naargelang je met de muis links of rechts gaat, laat ik die optie liggen.
Er gebeurt regelmatig iets onbedoelds, je gaat onbewust een grafiekelement gaan verslepen of veranderen van grootte/vorm.
Dus tenzij er iemand anders een optie ziet, blijft het bij klikken met de muis.
 
Prima en het hoeft niet perse met de muis het idee was met de pijltjestoetsen naar links of naar rechts nadat je met de muisklik een punt geselecteerd had. Wat me wel opviel dat in meetpunt 5 het selecteren van het 6e punt vanaf achteren geteld het 2e punt werd geselecteerd. Pas toen ik in een andere grafiek wat selecteerde kwam het probleem niet meer terug.
 
ja, soms gebeurt er iets onverwachts en dat herstelt zich door even naar de andere sheet te gaan.
Er zit voorlopig geen lijn in dat verschijnsel, dus kan ik het niet oplossen.

Ik denk dat je goed moet opletten, als een bepaald meetpunt heel dicht bij een horizontale lijn ligt, dan kan hij ook verkeerdelijk die horizontale lijn oppikken.
Daar heb ik geen controle over.
Als dat voorkomt, dan zou je even bovenin in die tabel moeten gaan kijken of je wel nog in de 1e serie bezig was.
Dat had je misschien ook kunnen zien op het ogenblik van klikken in dat kadertje die meeschuift, of je nog met de goeie serie bezig bent.
Dus goed opletten op dat kadertje op het ogenblik dat je klikt.
 
Ja ik zie het, zodra je een punt selecteert dicht bij een horizontale lijn en je klikt net niet goed dan wordt er verkeerde selectie gemaakt. Duidelijk.

Ik ben nog even aan het uitvogelen hoe msoThemeColorAccent werkt want de verticale markerlijn wil ik graag wat dunner en mangenta gekleurd. In de bijlage de laatste updates.
 

Bijlagen

  • afronden numberformat v2.2.xlsm
    306,8 KB · Weergaven: 15
Ik heb het opgelost met:
Code:
.Format.Line.ForeColor.RGB = RGB(238, 130, 255)
 
Daar is iets geks aan de hand, zoals je volgens mij ook al had opgemerkt is dat de punten niet allemaal even groot zijn van de 5 grafieken. Een andere vreemd iets is dat bij alle grafieken het eerste punt niet goed wordt weergegeven in de grafiek, de datum is bijvoorbeeld 1900.

Naast de afwijking >3s of <-3s moet er ook een afwijking komen voor 4 meetpunten>1s of 4 meetpunten <-1s. Ik dacht dit op te lossen met onderstaande code, het werkt alleen niet
Code:
                                                           For ipts = 1 To .Points.Count '2e eis afwijkende meetpunten
                                    
                                    If ipts > 3 Then
                                                If ((Abs(Ywaarden(ipts - 3)) - g) > sd And (Abs(Ywaarden(ipts - 2)) - g) > sd And (Abs(Ywaarden(ipts - 1)) - g) > sd And (Abs(Ywaarden(ipts - 1)) - g) > sd) Then
                                                    .Points(ipts).MarkerForegroundColor = RGB(255, 0, 0)
                                                    .Points(ipts).MarkerBackgroundColor = RGB(255, 0, 0)
                                                End If
                                    End If
                             Next
 

Bijlagen

  • afronden numberformat v2.2.xlsm
    327,4 KB · Weergaven: 15
Laatst bewerkt:
datum 1900 ? Waarschijnlijk is dat de 1 voor de horizontale serie¨n (1 = 1 januari 1900).
Ik zie het hier niet, dus kan het niet checken.

De afwijking wordt steeds positief weergegeven, anders moet je die Abs aanpassen.
Daarna moet je naargelang je wensen een extra case toevoegen en de rest mee aanpassen.
Code:
For ipts = 1 To .Points.Count     'alle punten aflopen en kleuren ngl. afwijking sd
                                   v = Application.Min([SIZE=3][COLOR="#FF0000"]Abs[/COLOR][/SIZE](Fix((Ywaarden(ipts - 1) - g) / sd)), 4)
                                   Select Case v
                                        [COLOR="#FF0000"]Case 0 To 1 'tussen -s en +s
                                             .Points(ipts).MarkerForegroundColor = RGB(0, 255, 255)     'inhoud punt rood<----------------nieuw
                                             .Points(ipts).MarkerBackgroundColor = RGB(0, 255, 255)     'rand punt rood<------------------nieuw

                                        Case 1 To 2     [/COLOR]        'aan deze moet je niets veranderen, standaard cobalt groene punten en anders groene doorlopende lijnen

                                        Case Else
                                             .Points(ipts).MarkerForegroundColor = RGB(255, 0, 0)     'inhoud punt rood<----------------nieuw
                                             .Points(ipts).MarkerBackgroundColor = RGB(255, 0, 0)     'rand punt rood<------------------nieuw
                                   End Select
                              Next
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan