Er der en skjult agenda? Eller bare et hack der er sat et hemmeligt sted?

Spørgsmål ikke forstået?  🙄

Hej Store- morten : -)

nyt link  : -))  https://www.dropbox.com/s/0i1krn8axudvjon/pr%C3%B8ve_2_bak.xlsx?dl=0

ved ikke hvorfor de ikke kan køre hver for sig?

det ser ud som om de følger hinanden ?
hvis du forstå  :-)

Hilsen Martin

Hej Martin

Den betinget formatering er "låst" til C3.

https://www.dropbox.com/s/67g73ov7eqnpmnf/Kopi%20af%20pr%C3%B8ve_3_bak.xlsx?dl=0

Hilsen Morten

Hej Morten :-)

hmm jeg takker men det  driller  endnu  :-(
kunne godt være jeg skulle have lidt hjælp

Hilsen Martin

Ja, kom frisk

Jo tak 😊

Er ved at være lidt i mål  😊  mangler lidt endnu
 
https://www.dropbox.com/s/242qsx4my6op57n/Nyt%20hj%C3%A6lpe%20ark_7_Pr%C3%B8ve_bak_2.xlsm?dl=0

Hilsen Martin  G.

Hvis jeg skal hente:
B19 - B20
hjælpe ark

over i Kørselsrapport?

Skal det være i Denne_projetmappe?
eller et anden sted  om?
hvordan ville koden se ud  :-)  så sætter jeg selv den ind :-)

Hvornår skal den hente cellerne?
F.eks. når Kørselsrapport aktivers?

Prøv at tilføje denne på Kørselsrapport:

Prøv at klikke rundt på arkene:
https://www.dropbox.com/s/bf47bzfrowk97qr/Nyt%20hj%C3%A6lpe%20ark_VBA_Hent.xlsm?dl=0

Hej  Morten  : -)

Som  sædvanlig så kan du det der  ;-)
Jeg takker mangen gangen og kigger / arbejder videre :-)

Synes  du ikke jeg er  sluppet meget godt fra det, end til videre ;-)

Hilsen Martin

Denne her  :
i

"Ny formateringsregel"
D2,D3
Har den nogle  funktioner?  Det ser godt ud?  (en synsmæssig funktion )  :-)

Hilsen Martin :-)

Ja, for syns skyld ;-)
Har rettet i den, lige nu.

Det kan jeg se nu dur det der med D2,D3 : -)

ja den drillet  lidt med datoen :-(

har lagt  Modules ind på også: -)

Der er noget med den med at hente tid på

https://www.dropbox.com/s/bpqofzr73xw2cgy/Nyt%20hj%C3%A6lpe%20ark_VBA_Hent%20%281%29_NY%20V1_med%20Modules.xlsm?dl=0

Den her køre lige med datoen  :-)

https://www.dropbox.com/s/79da18ibr1ps032/Nyt%20hj%C3%A6lpe%20ark_VBA_Hent_Morten_med%20moduil_a.xlsm?dl=0 

:-)

Det er lige som om hvis men lige sletter E3  med hånden  og gemmer og lukker og starter op igen for Excel så kommer den  :-)

For at få: Velkommens_box skal Kørselsrapport være tom/blank og B26: Til

Hvis der trykkes på Ja knappen sker intet andet end Velkommens_box lukkes?

Morten for  søren  :-)
ja det er rigtig  :-)
nu har jeg Tilføj det her  :-)
nu sker noget  .-)

Private Sub CommandButton3_Click()

Worksheets("Hjælpe Ark").Range("E3").Value = Worksheets("Hjælpe Ark").Range("B49").Value

Unload Me
/


UsserForm1
Private Sub cb_Ok_Click()   
'Hvis A5:E62 er tom, spørges om dato skal slettes
    If Worksheets("Hjælpe Ark").Range("I3") = "Tom" Then
        Dim bytAns As Long
        bytAns = MsgBox("Ark tomt! " & Worksheets("Hjælpe Ark").Range("E3").Value & " tilføjes som fast dato! " & _
            vbCrLf & " Ønsker du det?", vbYesNo + vbQuestion, _
            "Bekræft fast dato")
        If bytAns = vbYes Then
           
        Else
            Worksheets("Hjælpe Ark").Range("E3").ClearContents
        End If

kunne ovenstående ikke være teknisk set , overflødigs kode?

Den laver fejl ?



Dim bytAns As Long
       
        'bytAns = MsgBox("Du har anmodet om at slette: A5:E62" _
        & vbCrLf & " Ønsker du det?", vbYesNo + vbQuestion, _
        "Bekræft sletning.")'
       
        bytAns = MsgBox("Du har anmodet om at slette: A5:E62" & Worksheets("Hjælpe Ark").Range("E3").Value & " tilføjes som fast dato! " & _
        & vbCrLf & " Ønsker du det?", vbYesNo + vbQuestion, _
        "Bekræft sletning."

"Du har anmodet om at slette: A5:E62"
Worksheets("Hjælpe Ark").Range("E3").Value & "tilføjes som fast dato! "

Du har anmodet om at slette: A5:E62
27-08-2020 tilføjes som fast dato!

kan men ikke få det på ? i denne her Dim bytAns As Long

'bytAns = MsgBox

:-)

Hej Martin
Du får lige lidt fra mobilen 😀

Der er to bytAns
Den øverste er "slukket" med det lille tegn i starten.
Slet tegnet så den virker, og "sluk" evt. den nederste.

Ser lige den fejler!

Det ser ud til der er en tom linje i koden?

Kommer på pc om 10 min. 😛

Hej Morten  det lykkse  ;-)

      bytAns = MsgBox("Du har anmodet om at slette: A5:E62" & vbCrLf & _
            Worksheets("Hjælpe Ark").Range("E3").Value & " tilføjes som fast dato!" & _
            vbCrLf & " " & vbCrLf & " Ønsker du det?", vbYesNo + vbQuestion, _
            "Bekræft fast dato")

Tak skal du have  ;-)

Jeg smutter lige i seng  :-)

Så lang så godt  ;-)

Hilsen Martin  G.

Sub Hent()
Application.DisplayAlerts = False
For Each c In Range("F5:F33").Cells
    If Range(c.Address).Offset(0, -5).Interior.ColorIndex = -4142 And _
    Range(c.Address).Offset(0, -4).Interior.ColorIndex = -4142 Then
    Worksheets("Hjælpe Ark").Range(c.Address).Offset(0, 9) = Range(c.Address)
    Worksheets("Hjælpe Ark").Range(c.Address).Offset(0, 10) = Range(c.Address).Offset(0, 1)
Else
    Worksheets("Hjælpe Ark").Range(c.Address).Offset(0, 9).ClearContents
    Worksheets("Hjælpe Ark").Range(c.Address).Offset(0, 10).ClearContents
    End If
Next c
Application.DisplayAlerts = True
End Sub

Hej Morten  😊
Den kode med hente tider  😊
Den ser lidt sort ud for min viden : -)

For Each c In Range("F5:F33").Cells der tænker jeg den henter i Kørselsrapport

If Range(c.Address).Offset(0, -5).Interior.ColorIndex = -4142 And _ der kigger den på om der er farve i celler
    Range(c.Address).Offset(0, -4).Interior.ColorIndex = -4142 Then
 
Range(c.Address).Offset(0, -4) pas?
Worksheets("Hjælpe Ark").Range(c.Address).Offset(0, 9).ClearContents der tænker
jeg den skulle overfør i hjælpe ark? 
Sætte over i celle T / U 😊?


Hvad nu hvis den skulle gøre sådan her :
D5-D62 / E5-E62 / F5-F62 / G5-G62

Den kun må ignorere tiden i de sammenhængende celler?
som illustreret her: 

https://www.dropbox.com/s/x1b6al4zju6wibt/Gemmer%20kun%203%20ark%20uden%20VB.jpg?dl=0

Ny version 
https://www.dropbox.com/s/yw6g6noybn2aqam/Tom%20_K%C3%B8rselsrapport%20V1.xlsm?dl=0
med Modules

Hilsen Martin  G.

Hej Morten :-)

Tror den tager ud  udgangspunkt fra F fra nu ligger den over rigtig over i hjælpe ark :-)
 

Worksheets("Hjælpe Ark").Range(c.Address).Offset(0, 14) = Range(c.Address)
    Worksheets("Hjælpe Ark").Range(c.Address).Offset(0, 15) = Range(c.Address).Offset(0, 1)

lige ignorere den tiden hvis der er farve udfyldning kunne i en celle,  godt tænke mig det skulle være sammenhæng fra D-G



Sub Hent()
Application.DisplayAlerts = False
For Each c In Range("F5:F33").Cells
    If Range(c.Address).Offset(0, -2).Interior.ColorIndex = -4142 And _
    Range(c.Address).Offset(0, 1).Interior.ColorIndex = -4142 Then
    Worksheets("Hjælpe Ark").Range(c.Address).Offset(0, 14) = Range(c.Address)
    Worksheets("Hjælpe Ark").Range(c.Address).Offset(0, 15) = Range(c.Address).Offset(0, 1)
Else
    Worksheets("Hjælpe Ark").Range(c.Address).Offset(0, 14).ClearContents
    Worksheets("Hjælpe Ark").Range(c.Address).Offset(0, 15).ClearContents
    End If
Next c
Application.DisplayAlerts = True
End Sub

Eller fx hvis der kun var farve udfyldning i C og G så kunne jeg måske selv tilføje eller redigere i det hvornår den skulle ignorere tiden ;-)

er det noget med 

If Range(c.Address).Offset(0, -3).Interior.ColorIndex = -4142 (C)
If Range(c.Address).Offset(0, 1).Interior.ColorIndex = -4142  (G)

Kan ikke helt følge med ;-)
Men her er til rettet kode med kommentar:

Hej Morten : -)

Jeg takker 😊 jeg sætter din kode ind 😊
Men ligger lige den illustrering op 

https://www.dropbox.com/s/fxwpxlgbuxq4kzu/fyldte%20celler.jpg?dl=0

Ja det gå hurtig 😊 lå lige pludselig at tænkte, så fik jeg lige pludselig, selv  knækkede koden 😊 

Hmm jeg har rodet med

Private Sub CommandButton1_Click()
'Slet knap
Application.ScreenUpdating = False
' Denne makro sletter et forudvalgt område (A5:E62)i det aktive ark.
' Udskriften skal bekræftes i en meddelelsesboks.
    Dim bytAns As Long
       
           
      bytAns = MsgBox("Du har anmodet om at slette: A5:E62" & vbCrLf & _
            Worksheets("Hjælpe Ark").Range("B49").Value & " tilføjes som fast dato!" & _
            vbCrLf & " " & vbCrLf & " Ønsker du det?", vbYesNo + vbQuestion, _
            "Bekræft fast dato")
         


    If bytAns = vbYes Then
        Range("A5:E62").ClearContents
        Worksheets("Hjælpe Ark").Range("E3").ClearContents
        Worksheets("Hjælpe Ark").Range("T5:U62").ClearContents
        'Sletter fyld farve
        Range("A5:E62").Interior.Pattern = xlNone
       
'sætter dagens dato i E3
        Worksheets("Hjælpe Ark").Range("E3").Value = Worksheets("Hjælpe Ark").Range("B49").Value

    'Luk Userform
   
   
    Unload Me
    Else
        Exit Sub
    End If
Application.ScreenUpdating = True
End Sub 

Men skal lige skifte ark før den skifter dato
Er det noget med denne her Application.ScreenUpdating mon?

https://www.dropbox.com/scl/fi/3x708f7eq62yhhvm2pjgn/Tom-_K-rselsrapport-V3_dato.xlsm?dl=0&rlkey=6158fkyw4klip9cs83up1p3pa

Ignorer hvis der er fyldfareve i C og G:

"Men skal lige skifte ark før den skifter dato
Er det noget med denne her Application.ScreenUpdating mon?"

Nej, den hentes med makro når arket aktivers, for at undgå formel på Kørselsrapporten.

Ja men tænker når der,  er farve i begge cellerne på en gang 😊
Ikke kun i en af dem 😊  kan godt se det bliver lidt tweety på denne måde.

Så den må kun  reagerer  når der er farve i C og G,  men prøver at nøjes som den er nu  : -)

Mon der ville være et tricks til at datoen skifter, når men trykker ”JA” lige med det samme?

Prøv:

ØØv nu har jeg lige fået det med at gemme 😊

Der sker noget med datoen ☹ den Opdater ikke ser det ud til ☹

Kunne men lave så når men gemmer med og uden kode , at den lige løber en

opdatering rundt på Udskrive side 1, Udskrive side 2 ark 😊 ☹

https://www.dropbox.com/scl/fi/3x708f7eq62yhhvm2pjgn/Tom-_K-rselsrapport-V3_dato.xlsm?dl=0&rlkey=6158fkyw4klip9cs83up1p3pa

Huha  Morten  det var lige det der skulle til  ;-) 
tror ikke jeg kommer til at remme den  farve kombination :-)
som rel markerer jeg alle cellerne, men også nogle gange bare nogle celler :-)

"Mon der ville være et tricks til at datoen skifter, når men trykker ”JA” lige med det samme?"
Prøv:

Hmm der kom den ;-) den havde jeg lige over set  :-(  Jeg takker mangen gange ;-)

Hvordan var det nu  arbejder du med kode til hverdag?

Nej, jeg arbejde med højspænding ;-)

Jeg ved ikke om det bliver for tung at opdatere udskrive siderne hver gang du ændre på Kørselsrapporten?

oki,  det er noget helt anden  :-)

I mit arbejde gælder det om ikke at være i stødet 😉
Jeg arbejder på 50000 og 10000 volt.

Måske bare hver gang, der gemmes  på den ene og anden måde :-)
bliver ved ikke om det bliver for tung, er det ikke lige som når men  skifte ark
måske skal men tilbage på den gammeldags måde?  :-)

huha tænker men futter af , ved en hurtig berøring :-(

Prøv:

ja huha hvor skal den ligges henne mon?

På Kørselsrapporten :-)

Den ligger der i forvejen, der er blot tilføjet opdateringen.

Private Sub Worksheet_Change(ByVal Target As Range)

den havde jeg ikke lige luret hmm er også lidt træt nu: -)

synes umiddelbart ikke virker tung.
Opdater den hver gang ved hver tegn?
eller hvordan?

Den opdater hver gang du skriver/ændre i A5:E62

oki,  jeg synes  vi prøver :-) det skal også testes på min abr. pc'er

hmm så var der lige det med det der gemme haløje,  der ville du lige ville trække dig lidt Pt. ?  :-)

(Det er  simple hen, for at gøre det lidt mere ubrugelig uden hjælpe ark, og kode ):-)
lidt mere beskytte :-)
kunne også godt tænke mig med tiden, lige at når men henter tid,  at den  dividere dagens omsætning så men kan danne sig et overblik med time lønen :-)

UBS,  overfør den ikke farvede celler  med over ?

Nej den tager ikke farve med.
Vi arbejder hen i mod der ingen formler eller kode er på de 3 sider du vil gemme, så burde det være lige til højrebenet 😁

”Nej den tager ikke farve med.
Vi arbejder hen i mod der ingen formler eller kode er på de 3 sider du vil gemme, så burde det være lige til højrebenet 😁”

Hej Morten : -)

Ja den går den vej  : -)
Men kunne den lave en mere præcis overførsel?  Både med farver og fx fed skrift, ja en med det hele?

Tænker når koden forsvinder så kan den lige pludselig, ikke overfør tekst mere?

Fra Kørselsrapport over i Udskrive side 1, Udskrive side 2
Det skal kun være teksten og ikke mere (Alt anden skal være ubrugeligt)
Ved overhoved ikke om det er muligt at gemme med kun lidt kode? 

tænker også, hvis nu men laver overførelse koden, fx  Module2, og Hver gang men gemmer, så går den lige ned og laver en  overførelse manøvre,  eller lige som før når men skifter mellem arkene,  tænker også men kunne ligge dato overførsel der nede også, og navn og vognnummer 😊

Er Module en  form for overruling?  Den kan køre over alle ark?
hvad er den ”Denne_Projektmappe” hvor meget kan den?  😊

Tænker også men kunne spare lidt kode, og lidt energi og kræfter  😊
Måske denne her I Module1 eller i Denne_Projektmappe? (Som ikke skal gemmes med )  (Så bliver den overført så den ikke  knækker 😊 ) 

Private Sub Worksheet_Activate()
Worksheets("Kørselsrapport").Range("A3").Value = Worksheets("Hjælpe Ark").Range("B19").Value
Worksheets("Kørselsrapport").Range("B3").Value = Worksheets("Hjælpe Ark").Range("B20").Value

Worksheets("Kørselsrapport").Range("B66").Value = Worksheets("Hjælpe Ark").Range("T63").Value
Worksheets("Kørselsrapport").Range("B67").Value = Worksheets("Hjælpe Ark").Range("U63").Value

End Sub

https://www.dropbox.com/s/8c5q564yzucr01a/med%20lidt%20kode.jpg?dl=0

Kørselsrapport
Private Sub Worksheet_Activate()

Henter noget i Module2 :-)

Udskrive side 1
Private Sub Worksheet_Activate()

Henter noget i Module2 :-)

Udskrive side 2
Private Sub Worksheet_Activate()

Henter noget i Module2 :-)

Eller men kan bestemme
Kørselsrapport uden kode
Udskrive side 1 med kode
Udskrive side 2 med kode
Div1. uden kode

Kode fra Kørselsrapport

Private Sub CommandButton1_Click()
If Module1 ikke er med

Dim shp As Shape

    If Gem.Value = True Then
        Gem_Fil
    Else
        For Each shp In ActiveSheet.Shapes
          If shp.Type <> msoChart And shp.Type <> msoComment Then shp.Delete
        Next shp
            Gem_Som
        End If
End if

End Sub



End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Module1 ikke er med

If Not Intersect(Target, Range("$A$1:$E$1")) Is Nothing Then
        'Cancel = True
   
        Load UserForm1
        UserForm1.Show
        Range("E62").End(xlUp).Offset(1, 0).Select
    End If
End if
End Sub

Ved ikke om den kan se efter selve VBAprojecter  ellers skal det være hvis der ikke er noget bestem i Module1 eller i hjælpe ark  :-)

Hej Morten :-)

Jeg fik lige opdaterede  noget her 

https://www.dropbox.com/scl/fi/ekfbloy72zxev270s8h1t/Tom-_K-rselsrapport-V3_dato_Temp3.xlsm?dl=0&rlkey=cdpx174v4f5mt87o64lugo3zg

If Not Intersect(Target, Range("$A$1:$E$1")) Is Nothing Then
        'Cancel = True
 
        Load UserForm1
        UserForm1.Show

"  Hvad gør denne her mon?       
Range("E62").End(xlUp).Offset(1, 0).Select
" 

End If
End if
End Sub