Beveiligd gebied doorsturen via button

[BuSTeD]

Ik heb een vraagje omtrendt het gebruik van een formulier in Excel.

Ik gebruik een soort brief waarbij ik de gebruiker de mogelijkheid geef om wanneer de brief af is ( dus alle gegevens ingeput ) om via een button ( VBA code ) de brief in zijn mail te krijgen waardoor de gebruiker dit naar de klant kan sturen.

Hoe werkt de button ? Wel de gebruiker moet eerst het bereik aanduiden dat hij wil versturen, dan pas op de button duwen waarna hij naar zijn email gaat.

Ik zou graag dit formulier willen beveiligen zodat de gebruiker geen gegevens kan wissen, dus hij mag enkel de nodige delen invullen en van de rest mag hij niks doen dan alleen het bereik aanduiden en de button gebruiken

Dus ik heb de test gedaan, ik laat enkel de delen die ingevuld moeten worden ontgrendeld ( zodat hij ze kan invullen ) en de rest vergrendel ik, maar dan heb ik het probleem dat ik geen bereik meer kan aanduiden dus ook niet verzenden.

Heeft iemand hier een oplossing voor?

Alvast bedankt

 

[Roncancio]

Hallo,

Zonder code is het lastig om te bepalen wat er precies aan de hand is, maar als ik het zo lees, lijkt het er op dat je in je code gebruikt maakt van .Select. en op de volgende regel Selection.
Probeer dit te vermijden, door de regels te combineren.

Bijv.:

Range("A1:A10").Select
Selection.Value="Hallo"

Wordt dan:

Range("A1:A10").Value="Hallo"

Met vriendelijke groet,


Roncancio

 

[Wigi]

Post je andere code hier eens.

 

[BuSTeD]

Roncancio,

Dit is de code :

Option Explicit

[I]Sub Mail_Sheet_Outlook_Body()
' Don't forget to copy the function RangetoHTML in the module.
' Working in Office 2000-2007
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
 
    Set rng = Nothing
    Set rng = ActiveSheet.UsedRange
    'You can also use a sheet name
    'Set rng = Sheets("YourSheet").UsedRange

    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
 
    On Error Resume Next
    With OutMail
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = "Wachturen"
        .HTMLBody = RangetoHTML(rng)
        .Display   'or use .Send
    End With
    On Error GoTo 0
 
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
 
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub[/I]

Dit is de code. Het is niet zo dat er een range gebruikt wordt. De gebruiker moet eerst zijn bereik aanduiden en dan pass de knop indrukken.

IK zou veel liever een range gebruiken in deze code, maar weet niet hoe.

 

[Roncancio]

Hallo,

IK zou veel liever een range gebruiken in deze code, maar weet niet hoe.

Je zou het als volgt kunnen doen:

Set rng = ActiveSheet.Range("A1:A10")

Beter is het om een bereik te benoemen zodat je het makkelijk kan teruglezen. Dus:

Set rng = ActiveSheet.Range("Afdrukbereik")

.
Dit doe je als volgt:
- Selecteer het bereik
- Ga naar INVOEGEN - NAAM - DEFINIEREN
- Voer de naam in het tekstveld: Afdrukbereik
- Klik op Ok.

Met vriendelijke groet,


Roncancio

 

[BuSTeD]

Roncancio,

Ik heb dus volgende tekst in mijn code Set rng = Nothing
Set rng = ActiveSheet.UsedRange vervangen door uw tekst en ik krijg volgende boodschap in excel : The selection is not a range or the sheet is protected please correct and try again.

Er staat geen beveiliging in het het werkblad. Maar ik zou er dus wel één op willen plaatsen

 

[Roncancio]

Hallo,

Een voorbeeld zou wel handig zijn maar ik heb om te beginnen zelf maar een heel simpel voorbeeldje gestuurd.
In bijgevoegd bestand zitten 3 werkbladen. Werkblad1 is beveiligd. In werkblad1 zit tevens een blauw bereik. Dit bereik heet test. Door de macro "Verplaatsen" te starten wordt de gegevens van "Test" verplaatst naar werkblad2 zonder dat de beveiliging wordt verwijderd. Volgens mij komt dit in de richting van wat jij voor ogen heeft.

Als ik er naast zit, dan hoor ik dat graag.

Met vriendelijke groet,


Roncancio

 

[BuSTeD]

Roncancio,

Alvast bedankt voor te helpen.

Maar ik vrees dat ik het slecht uitgelegd heb.

Ik heb dan ook een voorbeeld in bijlage geplaatst. Je ziet daar 2 tabbladen, dispatch & facturatie. Het eerste tabblad (dispatch) wordt door een persoon ingevuld waardoor de gegevens gekopiëerd worden naar het tabblad facturatie + stuurt deze persoon dit ook door naar de klant. Het tabblad facturatie wordt door een andere persoon doorgestuurd ( voert hier geen wijzigingen aan uit ) naar de klant. De personen moeten dus eerst hun bereik aanduiden en dan pas op de button duwen waardoor de inhoud naar hun mail wordt gestuurd.

Dit zou fantastisch zijn moest beide tabbladen kunnen beveiligd worden. Nl. dispatch enkel de velden die ingevuld moeten worden niet beveiligen, rest wel. Bij facturatie mag het volledige document beveiligd worden. Maar beide tabbladen moeten wel nog ( apart ) worden kunnen doorgestuurd.

Mvg

 

[Roncancio]

Hallo,

Kun je het bestand zippen.
Ik kan geen .rar bestanden openen.

Met vriendelijke groet,


Roncancio

 

[BuSTeD]

Ron,

Ik kan spijtig genoeg niet zippen, heb enkel trial versie van winzip.

Tenzij je me kan zeggen hoe ik dit met een trial versie kan doen.

Maar euhm waarom kan ik geen .xls uploaden?

 

[Wigi]

Hier is een gezipte versie.

Dit kan trouwens ook met de trial versie.

Wigi

 

[BuSTeD]

Bedankt wigi,

hoop dat iemand me kan helpen.

Alvast bedankt voor jullie portie geduld

 

[Roncancio]

Hallo,

@Wigi, bedankt.:thumb:

@BuSTeD.
Ik zal er in de loop van de dag naar kijken.

Met vriendelijke groet,


Roncancio

 

[wiki]

Onderstaande routine kun je uitbreiden door om een selectie te vragen en vervolgens te printen of mailen na afloop wordt het werkblad weer beveiligd.

Option Explicit
Dim tijd
Const sleutel = "wachtwoord"


Sub beveiliging()
'
'
'
'
Application.ScreenUpdating = False
 ActiveSheet.Unprotect Password:=sleutel

    Application.ScreenUpdating = True
      ThisWorkbook.ActiveSheet.Protect Password:=sleutel
    
End Sub

 

[Roncancio]

Hallo,

Ik zie dat de code gekopieerd is uit een ander bestand, want volgens mij kan je uberhaupt niet printen. Er wordt verwezen naar een werkblad ("MailRangeSelection") die niet in het bestand zit.
Het bereik rng is dan dus altijd leeg waardoor je automatisch de melding krijg dat het een ongeldig bereik betreft.

Met vriendelijke groet,


Roncancio

 

[BuSTeD]

Ron,

Inderdaad, ik heb het ergens uit gekopieërd.

Het gaat dus nog steeds niet. Iemand enig idee waar ik het juiste kan vinden ofzo?

 

[Roncancio]

Hallo,

Onderstaande code heb ik gekopieerd uit de site van Ron de Bruin (http://www.rondebruin.nl/mail/folder1/mail2.htm)

Verander de vette rode tekst in het e-mailadres waar je het werkblad naartoe wilt sturen.

Sub Mail_ActiveSheet()
'Working in 97-2007
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set Sourcewb = ActiveWorkbook

    'Copy the sheet to a new workbook
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook

    'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007
            'We exit the sub when your answer is NO in the security dialog that you only
            'see  when you copy a sheet from a xlsm file with macro's disabled.
            If Sourcewb.Name = .Name Then
                With Application
                    .ScreenUpdating = True
                    .EnableEvents = True
                End With
                MsgBox "Your answer is NO in the security dialog"
                Exit Sub
            Else
                Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
        End If
    End With

    '    'Change all cells in the worksheet to values if you want
    '    With Destwb.Sheets(1).UsedRange
    '        .Cells.Copy
    '        .Cells.PasteSpecial xlPasteValues
    '        .Cells(1).Select
    '    End With
    '    Application.CutCopyMode = False

 

    'Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        On Error Resume Next
        .SendMail "[B][COLOR="Red"]ron@debruin.nl[/COLOR][/B]", _
                  "This is the Subject line"
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

    'Delete the file you have send
    Kill TempFilePath & TempFileName & FileExtStr

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With

End Sub

Met vriendelijke groet,


Roncancio

 

[BuSTeD]

Roncancio,

Ik kan niks doen met deze code Ron.

Op het tabblad facturatie zie je dat bepaalde kolommen op hide staan. In deze hide kolommen staat belangrijke informatie die de klant niet mag zien. Met de code die je me gegeven hebt staat het volledig tabblad facturatie in bijlage van de mail.

Is het niet mogelijk enkel een bereik in mail te krijgen zonder de hide kolommen ?

Mvg

 

[brandernl]

Maken we het niet te ingewikkeld?
Je wilt toch een vaste range, namelijk het hele formulier versturen?

 

[wiki]

OP deze website www.rondebruin.nl vind je een add.in sendmail. Hiermee kun je een selectie mailen.