Gegevens van een excel bestand overnemen in ander bestand

[davylenders123]

Cobbe , Warm bakkertje

Heb een wijziging moeten doen voor 1 klant aan het bestandje maar krijg het niet helemaal klaar.
Heb bij de velden die altijd moeten worden ingevuld 1 lijnen moeten toevoegen (invulblad h 29) extra info)
En op data tablad moet hij cel h 29 en h 31 overnemen in de kolom j en k.
Maar krijg dit niet klaar in de code , heb al van alles geprobeerd.



Cel h 29 moet bij het lijstje komen van de lijnen die moeten ingevuld zijn voor je de button kan gebruiken.
En cel h 29 moet in het data tablad overgenomen worden in rij j (deze moet altijd worden ingegeven of je kan niet verder)
En cel h 31 moet in het data tablad overgenomen worden in rij k (dit is gewoon een extra lijnen indien nodig)


Ook als het bestandje gemaild wordt krijgt de ontvanger bij opening van het excel bestand het volgende pop up te zien

" deze werkmap bevat koppelingen naar andere gegevens bron ......"
En kan je kiezen uit het volgende.
" bewerken niet bewerken help "

Kan ik er iets aan wijzigen zodat ze deze melding niet meer krijgen.

Kan je mij nog eens even verder helpen aub.

 

[Warme bakkertje]

Test deze eens

 

[davylenders123]

Bedankt :thumb:

Dit is hem bijna.

Enkel in het tabblad data daar zou in cel E1 nog de actuele datum tijd moeten komen elke keer je het bestandje open doet.
En de cel moet bij het opslaan terug leeg worden gemaakt.

Zodat je elke keer het actuele datum en uur hebt en als ze daar de buton afdrukken mailen gebruiken dat dan de datum en uur worden meegegeven met het bestand en ook worden afgedrukt bij het afdrukken.

 

[davylenders123]

Heb nog een probleempje

Heb ook geprobeerd om het bijhouden van wijzigingen van alle gebruikers in te voegen maar dan loopt de code altijd vast op.
( waar hij vast loopt staat in het blauw en het is op het data tablad)

Dim PreviousValue
Private Sub Worksheet_Change(ByVal target As Range)
[COLOR="#0000CD"]If target.Value <> PreviousValue Then[/COLOR]
Sheets("log").Cells(65000, 1).End(xlUp).Offset(1, 0).Value = _
            Application.UserName & " changed cell " & ActiveSheet.Name & target.Address _
            & " from " & PreviousValue & " to " & target.Value & " Date " & Date & "  " & Time
End If
            
End Sub

Private Sub Worksheet_SelectionChange(ByVal target As Range)
PreviousValue = target.Value
End Sub

Dit is de link naar de vraag over wijzigingen bij te houden
http://www.helpmij.nl/forum/showthr...lke-gebruiker-een-wijziging-heeft-aangebracht

 

[Warme bakkertje]

Sub mailoutlook2()

    If vbNo = MsgBox("Ben je wel zeker dat je die mail wil verzenden", vbYesNo) Then Exit Sub
    With Sheets("Data")
        .Unprotect Password:="1302"
        .Range("E1") = Format(Now, "dd-mm-yyyy hh" & "u " & "mm")
        .Protect Password:="1302", DrawingObjects:=True, Contents:=True, Scenarios:=True
    End With
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=("G:\Pakketten\Everyone\Transit\Retour Opdrachten\Afgewerkte retouropdrachten\Nutricia1\aangemelde lijsten" & "\Transit - aanmeldlijst retouren Nutricia " & Sheets("invulblad").Cells(7, 12).Value & " Doorgestuurd op " & Format(Now, "dd-mm-yyyy hh" & "u " & "mm") & ".xls")
    Application.DisplayAlerts = True

    With CreateObject("Outlook.Application").createitem(olMailItem)
        .To = "davy.lefrs@ffff.be"
        .cc = "davy.lfrs@tff.be"
        .Subject = "Aanmeldlijst retouren van Nutricia  " & Format(Now, "dd-mm-yyyy hh" & "u " & "mm") & ".xls"
        .body = Replace("Klantendienst,##In bijlage de verzamelijst van de retouren van Nutricia die we in transit hebben staan.#Gelieve deze zo snel mogelijk te laten afhalen.#Deze zijn apart gezet en dienen dan ook samen aangemeld en afgehaald te worden.##Met Vriendelijke Groeten##Transit medewerker###", "#", vbCr)
        .Attachments.Add ThisWorkbook.Path & "\" & ThisWorkbook.Name
        .Send
    End With
    With Sheets("invulblad")
        .Unprotect Password:="1302"
        .Range("B20").ClearContents
        Application.Goto .Range("B12")
        .Protect Password:="1302", DrawingObjects:=True, Contents:=True, Scenarios:=True
    End With
    With Sheets("Data")
        .Unprotect Password:="1302"
        .Range("A3:I50,E1").ClearContents
        Application.Goto .Range("A1"), True
        .Protect Password:="1302", DrawingObjects:=True, Contents:=True, Scenarios:=True
    End With
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=("G:\Pakketten\Everyone\Transit\Retour Opdrachten\origineel retour opdrachten\Transit - Retour opdrachten Nutricia2.xls")
    Application.DisplayAlerts = True
    
  MsgBox "De e - mail is correct verstuurd en de gegevens zijn correct opgeslagen", vbInformation
End Sub

 

[davylenders123]

Warm Bakkertje

Ik vermoed dat dit de oplossing is voor vraag 23. en niet ook voor die van vraag 24.

Heb het op de versie toegepast waar de log gegevens worden bijgehouden en daar blijf ik op dezelfde foutmelding lopen.

Als ik het op de versie zonder log toepast werkt de datum uur in tabblad data wel.

Dus de versie zonder de log gegevens werkt nu zoals het zou moeten.

 

[Warme bakkertje]

Als antwoord op Post#24.
Dit heeft alles te maken met de beveiligigng op je werkblad Data.

 

[davylenders123]

warm bakkertje

Heel hard bedankt voor al je hulp al :thumb: echt top wat jullie hier allemaal doen.:thumb::thumb:

Heb het werkende gekregen zonder de log file.

Ik ga het nu zo ook houden want andere krijg ik niet werkent .


Kan ik enkel nog iets toevoegen aan de code van userform zodat deze op het laatste ook automatisch terug dicht gaat als hij alles heeft gedaan.
afdrukken opslaan en mailen.(geprobeerd met macro ôpnemen maar lukte niet)

Als je nu de button hebt gebruikt en is helemaal klaar dan staat de userform nog op je scherm terug leeg.
Kan ik iets toevoegen dat het gewoon sluit.
Of heel de excel mag trouwens helemaal op het laatste sluiten als dit kan na gebruik userform.

En is het mogelijk om in het tabblad data bv in rij Z de gebruiker wordt bij gehouden die die lijn heeft aangemaakt door de userform gebruikt te hebben.
Dus automatisch bij het invullen van de userform ,dat in kolom Z in data sheet op de lijn waar de andere gegevens worden overgenomen de gebruikersnaam van die persoon wordt overgenomen .

Deze is dan niet zichtbaar zo direct en wordt ook niet mee afgedrukt.

Heb nog even de laatste versie toegevoeg

 

[Warme bakkertje]

Test.

 

[davylenders123]

Warm bakkertje

Dit is hem helemaal.
Bedankt voor al de hulp.
Trouwens Cobe ook bedankt voor u hulp.

top:thumb:

 

[davylenders123]

Warm bakkertje

Kan je mij vertellen hoe ik de pop up kan wijzigen die op komt dat je in invulblad een veld bent vergeten in te vullen.
De lijn van de extra info moet voor een ander bestand wel blijven staan maar moet niet altijd worden ingevuld.
Dus als veld leeg is moet in die pop niet komen dat je dit veld nog moet invullen.

Heb in de code wat in het rood staat verwijderd maar dan blijft hij de melding geven.
Ik krijg dan ook in het data tablad bij extra info "#N/B" te staan.

Private Sub CommandButton1_Click()
    msg = "Ontbrekende verplichte gegevens zijn :" & vbLf & vbLf: nmb = 0
    For Each ctl In Me.Controls
        If ctl.Tag <> vbNullString Then
            If TypeName(ctl) = "TextBox" And ctl.Value = vbNullString Then msg = msg & ctl.Tag & vbLf: nmb = nmb + 1
        End If
    Next
    If nmb > 0 Then MsgBox msg: Exit Sub
    For i = 1 To 18
        Sheets("invulblad").Range(Choose(i, "B10", "B12", "B14", "B16", "C20", "C22", "C24", "H20", "H22", _
                    "H24", "H29", "C31", "H31", "C33", "G33", "B41", "B44", "E55")) = Me("TextBox" & i).Text
    Next
    For i = 1 To 5
         If Me("CheckBox" & i) Then Blad1.CheckBoxes("Selectievakje " & i).Value = True
    Next
    Sheets("invulblad").Range("B47") = Me.ComboBox1.Value
    With Sheets("invulblad")
        .PrintOut Copies:=2
        Sheets("data").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, 11) = Array(.Range("B12"), .Range("B14"), .Range("B16"), _
                    .Range("C20"), .Range("C22"), .Range("C24"), .Range("H20"), .Range("H22"), .Range("H24")[COLOR="#FF0000"], .Range("H29"), .Range("H31")[/COLOR])
        Sheets("data").Range("A" & Rows.Count).End(xlUp).Offset(, 25).Value = Application.UserName
        .Copy
    End With
    Dim vLinks As Variant, lLink As Long
    With ActiveWorkbook
        On Error Resume Next
        vLinks = .LinkSources(Type:=xlLinkTypeExcelLinks)
        For lLink = LBound(vLinks) To UBound(vLinks)
            .BreakLink vLinks(lLink), xlLinkTypeExcelLinks
        Next lLink
        On Error GoTo 0
        .SaveAs ThisWorkbook.Path & "\Retouren Greiner Bio One .xls"
        .Close True
    End With
    With CreateObject("Outlook.Application").createitem(olMailItem)
        .To = "davy.lenders@postnl.be"
        .cc = ""
        .Subject = "Retouropdracht Greiner Bio One   " & Format(Now, "dd-mm-yyyy hh" & "u " & "mm") & ".xls"
        .body = Replace("Checkpoint Turnhout,##In bijlage een retouropdracht van Greiner Bio One  voor op SE 40 te zetten.##Met Vriendelijke Groeten##Transit medewerker###", "#", vbCr)
        .Attachments.Add ThisWorkbook.Path & "\Retouren Greiner Bio One .xls"
        .Send
    End With
    Kill ThisWorkbook.Path & "\Retouren Greiner Bio One .xls"
    For i = 1 To 18
        Sheets("invulblad").Range(Choose(i, "B10", "B12", "B14", "B16", "C20", "C22", "C24", "H20", "H22", _
                    "H24", "H29", "C31", "H31", "C33", "G33", "B41", "B44", "E55:J55")).ClearContents
        Me("TextBox" & i).Text = vbNullString
    Next
    Sheets("invulblad").Range("B47").ClearContents
    For i = 1 To 5
         Me("CheckBox" & i).Value = False: Blad1.CheckBoxes("Selectievakje " & i).Value = False
    Next
    ComboBox1.Value = vbNullString
    ThisWorkbook.Save
    Shutdown
End Sub

 

[Warme bakkertje]

Ga naar de eigenschappen van de extra info textbox.
Bij de Tag-property verwijder je de tekst die daar staat, al de rest v/d code hoeft niks gewijzigd te worden.

 

[davylenders123]

Warm bakkertje


Nogmaals bedankt :thumb: