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

Hulp gezocht macro knop

Status
Niet open voor verdere reacties.

Mollema

Gebruiker
Lid geworden
26 feb 2019
Berichten
28
Hallo allemaal,

ik ben opzoek naar iemand die voor mij een macro knop kan instellen met meerder functies.
ik ben zelf al een tijdje aan het proberen maar ik kom er zelf niet uit en snap en weinig van vandaar dat ik hier om jullie hulp vraag.

ik heb een werkplek verslag wat ik elke dag in vul en mail alleen nu moeten we alles handmatig doen dat zou ik graag onder 1 knop willen als dat mogelijk is.
het gaat om de volgende functies:

blad kopieren en er onder plakken op het zelfde tabblad, wanneer er een nieuwe maand is dat hij opnieuw begint op een nieuw tabblad, zo dat je van elke maand een nieuw tabblad hebt en dus makkelijk kan terug lezen.
cellen leeg maken en een aantal cellen overnemen in een andere cel.
verzenden als pdf in bijlage naar een vast mail adres.

ik heb het bestand er bij gezet, ik hoop dat er iemand is die mij wil en kan helpen.

alvast bedankt.
 

Bijlagen

  • MKRleeg.xlsx
    16,6 KB · Weergaven: 56
Code:
Sub hsv()
With Sheets("blad1")
 If IsError(Evaluate("'" & Format(.Range("K4"), "mmmm") & "'!A1")) Then Sheets.Add(, Sheets(Sheets.Count)).Name = Format(.Range("k4"), "mmmm")
  .UsedRange.Copy Sheets(Format(.Range("K4"), "mmmm")).Cells(Rows.Count, 1).End(xlUp).Offset(1)
    Sheets(Format(.Range("k4"), "mmmm")).UsedRange = Sheets(Format(.Range("k4"), "mmmm")).UsedRange.Value
    Sheets(Format(.Range("k4"), "mmmm")).Shapes(1).Delete
End With
End Sub
 
Code:
Sub hsv()
With Sheets("blad1")
 If IsError(Evaluate("'" & Format(.Range("K4"), "mmmm") & "'!A1")) Then Sheets.Add(, Sheets(Sheets.Count)).Name = Format(.Range("k4"), "mmmm")
  .UsedRange.Copy Sheets(Format(.Range("K4"), "mmmm")).Cells(Rows.Count, 1).End(xlUp).Offset(1)
    Sheets(Format(.Range("k4"), "mmmm")).UsedRange = Sheets(Format(.Range("k4"), "mmmm")).UsedRange.Value
    Sheets(Format(.Range("k4"), "mmmm")).Shapes(1).Delete
End With
End Sub

Bedankt, is het ook mogelijk om de andere functies onder de knop te maken?
 
Dat is ook mogelijk.

Hier met Outlook.

Code:
Sub hsv()
With Sheets("blad1")
 If IsError(Evaluate("'" & Format(.Range("K4"), "mmmm yy") & "'!A1")) Then Sheets.Add(, Sheets(Sheets.Count)).Name = Format(.Range("k4"), "mmmm yy")
  .UsedRange.Copy Sheets(Format(.Range("K4"), "mmmm yy")).Cells(Rows.Count, 1).End(xlUp).Offset(1)
  .ExportAsFixedFormat 0, "c:\temp\" & .Range("k4").Value
    With CreateObject("Outlook.Application").CreateItem(0)
      .to = "mailadres@gmail.com"
      .Subject = "blabla"
      .attachments.Add "c:\temp\" & Sheets("blad1").Range("k4").Value & ".pdf"
      .display '(voor directe versturen gebruik je) .send
    End With
 Kill "c:\temp\" & .Range("k4").Value & ".pdf"
  
  .Range("c8").Resize(, 7).ClearContents
  .Range("k8").Resize(2, 4).ClearContents
  .Range("c10").Resize(, 8).ClearContents
  .Range("b12:n19,b22:n29").ClearContents
 
    Sheets(Format(.Range("k4"), "mmmm yy")).UsedRange = Sheets(Format(.Range("k4"), "mmmm yy")).UsedRange.Value
    Sheets(Format(.Range("k4"), "mmmm yy")).Shapes(1).Delete
End With
End Sub
 
Laatst bewerkt:
dit is fantastisch, hier ben ik echt heel blij mee.

is het ook nog mogelijk dat u nog een aantal dingen toevoegt?
wanneer je opslaat dat de nieuwste boven aan komt in het werkblad van de maand?
en zou het lege gedeelte boven de cellen ook mee kunnen worden genomen, ik heb daar een logo staan en die komt half op de pagina te staan zo als het nu zit.
de datum van de dag mee kopieen, zo dat je terug kan lezen/zoeken op datum.
en de inhoud op het invul blad van de cellen 10C t/m 10N worden gekopieerd naar de cellen 8C t/m 8N ( behalve cel J ) dat zijn de draaiuren die elke dag dus optelt.

in het excel bestand kan je zien in de werkmap februari dat hij overlapt per pagina
 

Bijlagen

  • MACHINEKAMERRAPPORT met macro.xlsm
    35,8 KB · Weergaven: 57
Gaat het zo beter?
Code:
Sub hsv()
With Sheets("blad1")
 If IsError(Evaluate("'" & Format(.Range("K4"), "mmmm yy") & "'!A1")) Then Sheets.Add(, Sheets(Sheets.Count)).Name = Format(.Range("k4"), "mmmm yy")
  .UsedRange.Copy
   Sheets(Format(.Range("K4"), "mmmm yy")).Rows(1).Resize(.UsedRange.Rows.Count).Insert xlDown
   Sheets(Format(.Range("K4"), "mmmm yy")).Cells(1).PasteSpecial xlPasteAll
   Sheets(Format(.Range("K4"), "mmmm yy")).Cells(1).PasteSpecial xlPasteColumnWidths
  .ExportAsFixedFormat 0, "c:\temp\" & .Range("k4").Value
    With CreateObject("Outlook.Application").CreateItem(0)
      .to = ""
      .Subject = "Machinekamerrapport"
      .attachments.Add "c:\temp\" & Sheets("blad1").Range("k4").Value & ".pdf"
      .display '(voor directe versturen gebruik je) .send
    End With
 Kill "c:\temp\" & .Range("k4").Value & ".pdf"
  
  .Range("c8").Resize(, 7).ClearContents
  .Range("k8").Resize(2, 4).ClearContents
  .Range("c10").Resize(, 8).ClearContents
  .Range("b12:n19,b22:n29").ClearContents
 Sheets(Format(.Range("k4"), "mmmm yy")).UsedRange = Sheets(Format(.Range("k4"), "mmmm yy")).UsedRange.Value
 Sheets(Format(.Range("k4"), "mmmm yy")).Shapes(1).Delete
End With
End Sub
 
Gaat het zo beter?
Code:
Sub hsv()
With Sheets("blad1")
 If IsError(Evaluate("'" & Format(.Range("K4"), "mmmm yy") & "'!A1")) Then Sheets.Add(, Sheets(Sheets.Count)).Name = Format(.Range("k4"), "mmmm yy")
  .UsedRange.Copy
   Sheets(Format(.Range("K4"), "mmmm yy")).Rows(1).Resize(.UsedRange.Rows.Count).Insert xlDown
   Sheets(Format(.Range("K4"), "mmmm yy")).Cells(1).PasteSpecial xlPasteAll
   Sheets(Format(.Range("K4"), "mmmm yy")).Cells(1).PasteSpecial xlPasteColumnWidths
 [COLOR="#FF0000"] .ExportAsFixedFormat 0, "c:\temp\" & .Range("k4").Value[/COLOR]
    With CreateObject("Outlook.Application").CreateItem(0)
      .to = ""
      .Subject = "Machinekamerrapport"
      .attachments.Add "c:\temp\" & Sheets("blad1").Range("k4").Value & ".pdf"
      .display '(voor directe versturen gebruik je) .send
    End With
 Kill "c:\temp\" & .Range("k4").Value & ".pdf"
  
  .Range("c8").Resize(, 7).ClearContents
  .Range("k8").Resize(2, 4).ClearContents
  .Range("c10").Resize(, 8).ClearContents
  .Range("b12:n19,b22:n29").ClearContents
 Sheets(Format(.Range("k4"), "mmmm yy")).UsedRange = Sheets(Format(.Range("k4"), "mmmm yy")).UsedRange.Value
 Sheets(Format(.Range("k4"), "mmmm yy")).Shapes(1).Delete
End With
End Sub

sorry voor de late reactie, ben een paar dagen weg geweest.
als ik dit invoer loopt hij vast op " .ExportAsFixedFormat 0, "c:\temp" & .Range("k4").Value"
 
Heb je de map "temp" ook op C staan? Of zitten er foute tekens in de bestandsnaam in cel k4?
 
de map "temp" staat nu in C en het werkt:d

de inhoud op het invul blad van de cellen 10C t/m 10N worden nog niet gekopieerd naar de cellen 8C t/m 8N, is dat nog mogelijk?
 
Dat zal geen probleem zijn, maar er staan formules in K10:N10 die een verwijzing hebben naar K8:N8.
 
klopt daar staat een som in, het aantal liters wat gebruikt is trekt hij dan van het totaal aantal liters af.
door de som kan je de gegevens niet overzetten dan?
 
Probeer het maar eens weer.
Code:
Sub hsv()
With Sheets("blad1")
 If IsError(Evaluate("'" & Format(.Range("K4"), "mmmm yy") & "'!A1")) Then Sheets.Add(, Sheets(Sheets.Count)).Name = Format(.Range("k4"), "mmmm yy")
  .UsedRange.Copy
   Sheets(Format(.Range("K4"), "mmmm yy")).Rows(1).Resize(.UsedRange.Rows.Count).Insert xlDown
   Sheets(Format(.Range("K4"), "mmmm yy")).Cells(1).PasteSpecial 12
   Sheets(Format(.Range("K4"), "mmmm yy")).Range("c8:i8") = Sheets(Format(.Range("K4"), "mmmm yy")).Range("c10:i10").Value
   Sheets(Format(.Range("K4"), "mmmm yy")).Range("k8:n8") = Sheets(Format(.Range("K4"), "mmmm yy")).Range("k10:n10").Value
  ' Sheets(Format(.Range("K4"), "mmmm yy")).Range("c10:i10,k10:n10").ClearContents
   
  .ExportAsFixedFormat 0, "c:\temp\" & .Range("k4").Value
    With CreateObject("Outlook.Application").CreateItem(0)
      .To = ""
      .Subject = "Machinekamerrapport"
      .attachments.Add "c:\temp\" & Sheets("blad1").Range("k4").Value & ".pdf"
      .display '(voor directe versturen gebruik je) .send
    End With
 Kill "c:\temp\" & .Range("k4").Value & ".pdf"
  
  .Range("c8").Resize(, 7).ClearContents
  .Range("k8").Resize(2, 4).ClearContents
  .Range("c10").Resize(, 8).ClearContents
  .Range("b12:n19,b22:n29").ClearContents
 Sheets(Format(.Range("k4"), "mmmm yy")).UsedRange = Sheets(Format(.Range("k4"), "mmmm yy")).UsedRange.Value
 Sheets(Format(.Range("k4"), "mmmm yy")).Shapes(1).Delete
End With
End Sub
 
zou je eens willen kijken of ik iets verkeerd doen?
bij mij werkt het niet hij neemt geen draaiuren/liters over.
 

Bijlagen

  • MKR2.xlsm
    26 KB · Weergaven: 36
Waar kan ik die vinden.
 
De waardes van de cellen, C10 t/m I10 ( urenstand einde dag ) en K10 t/m N10 ( liters in tanks einde dag )
moeten worden gekopieerd naar cellen C8 t/m I8 ( urenstand begin dag ) en naar K8 t/m N8 ( liters in tanks begin dag )
als dat mogelijk is met de sommen die in bepaalde cellen staan :)
 
Vul eens wat gegevens in, en geef eens aan wat er niet goed gaat.

In mijn test wordt het gewoon weggeschreven.
 
Ten eerste ben ik zeer blij met je geduld en dankbaar dat je me helpen wil:thumb:

In de bijlage staat nu een ingevuld blad dat gekopieerd is naar het blad "maart 19".
De gegevens van blad "maart 19" in cellen, C10 t/m I10 en K10 t/m N10 moeten na het drukken op de knop over worden gezet naar cellen C8 t/m I8 en naar K8 t/m N8 op "Blad1".

De gegevens in bladrij 20 en bladrij 30 van "Blad1" worden ook niet gewist.
 

Bijlagen

  • MKR test.xlsm
    28,5 KB · Weergaven: 67
Dan had ik niet begrepen dat het naar blad1 moest.

Code:
Sub hsv()
Application.ScreenUpdating = False
With Sheets("blad1")
 If IsError(Evaluate("'" & Format(.Range("K4"), "mmmm yy") & "'!A1")) Then Sheets.Add(, Sheets(Sheets.Count)).Name = Format(.Range("k4"), "mmmm yy")
  .UsedRange.Copy
   Sheets(Format(.Range("K4"), "mmmm yy")).Rows(1).Resize(.UsedRange.Rows.Count).Insert xlDown
   Sheets(Format(.Range("K4"), "mmmm yy")).Cells(1).PasteSpecial 12
   .Range("c8:i8") = Sheets(Format(.Range("K4"), "mmmm yy")).Range("c10:i10").Value
   .Range("k8:n8") = Sheets(Format(.Range("K4"), "mmmm yy")).Range("k10:n10").Value
   .ExportAsFixedFormat 0, "c:\temp\" & .Range("k4").Value
    With CreateObject("Outlook.Application").CreateItem(0)
      .To = ""
      .Subject = "Machinekamerrapport"
      .attachments.Add "c:\temp\" & Sheets("blad1").Range("k4").Value & ".pdf"
      .display '(voor directe versturen gebruik je) .send
    End With
 Kill "c:\temp\" & .Range("k4").Value & ".pdf"
  .Range("k9").Resize(, 4).ClearContents
  .Range("c10").Resize(, 8).ClearContents
  .Range("b12:n20,b22:n30").ClearContents
 Sheets(Format(.Range("k4"), "mmmm yy")).UsedRange = Sheets(Format(.Range("k4"), "mmmm yy")).UsedRange.Value
 Sheets(Format(.Range("k4"), "mmmm yy")).Shapes(1).Delete
End With
End Sub
 
Laatst bewerkt:
Helemaal fantastische, precies wat ik bedoel. :thumb:

kan het kloppen dat hij "blad1" kopieert t/m rij 38? zou dit t/m rij 32 kunnen, dan staat het mooier verdeeld onder elkaar op blad "maart 19"
 
Laatst bewerkt:
Beter zo?

Code:
Sub hsv()
Application.ScreenUpdating = False
With Sheets("blad1")
 If IsError(Evaluate("'" & Format(.Range("K4"), "mmmm yy") & "'!A1")) Then Sheets.Add(, Sheets(Sheets.Count)).Name = Format(.Range("k4"), "mmmm yy")
   .Range("A1:N30").Copy
   Sheets(Format(.Range("K4"), "mmmm yy")).Rows(1).Resize(30).Insert xlDown
   Sheets(Format(.Range("K4"), "mmmm yy")).Cells(1).PasteSpecial 12
   .Range("c8:i8") = Sheets(Format(.Range("K4"), "mmmm yy")).Range("c10:i10").Value
   .Range("k8:n8") = Sheets(Format(.Range("K4"), "mmmm yy")).Range("k10:n10").Value
   .ExportAsFixedFormat 0, "c:\temp\" & .Range("k4").Value
    With CreateObject("Outlook.Application").CreateItem(0)
      .To = ""
      .Subject = "Machinekamerrapport"
      .attachments.Add "c:\temp\" & Sheets("blad1").Range("k4").Value & ".pdf"
      .display '(voor directe versturen gebruik je) .send
    End With
 Kill "c:\temp\" & .Range("k4").Value & ".pdf"
  .Range("k9").Resize(, 4).ClearContents
  .Range("c10").Resize(, 8).ClearContents
  .Range("b12:n20,b22:n30").ClearContents
End With
End Sub
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan