Makro og VBA - Knap til gem+lækkert layout

Print side | Luk vindue

Knap til gem+lækkert layout

Udskrevet fra: Dansk Regneark Forum
Kategori: Hjælp til regneark.
Forum navn: Makro og VBA
Forum beskrivelse: Hjælp til Makroer og VBA-programmering
Web-adresse: https://forum.excel-regneark.dk/forum_posts.asp?TID=293
Udskrevet den: 05.Dec.2024 kl. 03:31

Emne: Knap til gem+lækkert layout

Besked fra: Weiss
Emne: Knap til gem+lækkert layout
Posteringsdato: 24.Mar.2011 kl. 08:08

?1:

Jeg kan se lignene udfordringer andre steder med PDF filer- men jeg vil blot lave knap der gemmer filen på skrivebordet hos brugeren. Filnavnet skal være en tekst "PEP"_ og indholdet af en celle i arket(et navn) og i Excel format. Jeg bruger Excel 2003.(...det er lykkedes mig at få den til at gemme på c-drev men mangler hvad jeg skal skrive for at den istedet vælger skrivebordet hos den der har filen åben)

Jeg er usikker på hvilken forskel det gør at indspille en makro fremfor bare at lave den som en "CommandButton" (har ikke arbejdet i Excel så længe).

?2:

Det skal bruges i et "spørgeskema" som jeg har lavet - og her vil jeg gerne gøre det lidt smart, så brugeren ikke kan ændre, slette, sætte curser andre steder end hvor jeg gerne vil have det (kun dér hvor de skal vælge en ud af fire kontrolelementer som er kædet sammen i en cellekæde). - ialt på 12 ark.

Er det beskyt/lås funktion jeg skal bruge til alle andre celler end den jeg vil have de kan sætte en prik i - eller hvad gør jeg)?

Håber på et klogt hoved

lige kan klare det

Smil fra Weiss

Svar:

Besked fra: Allan
Posteringsdato: 24.Mar.2011 kl. 11:03

Hej Weiss,

Svar på spørsmål 1:

Denne stump kode kan finde den aktive bruges skrivebord.

Når du skal bruge koden i PDF-sammenhæng, skal du bare angive objFolders("desktop") som sti.

Sub FindSkrivebord()
Dim objFolders As Object
Set objFolders = CreateObject("WScript.Shell").SpecialFolders

MsgBox objFolders("desktop")

End Sub

//Allan

Besked fra: rassten
Posteringsdato: 25.Mar.2011 kl. 17:49

2.
Fjern beskyttelsen fra de celler som er linket, der efter "beskyt arket". Hvis du ikke først fjerner beskyttelsen fra de linket celler vil de ikke virke. Slut af med med at skjule kolonnerne med de linket celler.

1.


Sub GemSkrivebord()
BN = "PEP_" & Worksheets("Ark1").Range("A1")
ActiveWorkbook.SaveAs Filename:= _
        CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & BN & ".xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
End Sub

Denne makro køre så ved en knap på sidste side i mit eksempel.
Filen får navnet "PEP_" og det navn som på Ark1 celle A1, det kan du selv ændre i ovenstående kode.
Filen bliver gemt som Excel2003 på skrivebordet.
Ovenstående virker, men jeg ved at Allan kan lave en makro som ser betydelig bedre ud

uploads/107/Sp%C3%B8rgeskema-3.xls - uploads/107/Spørgeskema-3.xls

-------------
VH rassten

Arbejde excel 2010
Privat excel 2010

Besked fra: Weiss
Posteringsdato: 25.Mar.2011 kl. 22:04

Mange tak til jer begge to

, jeg er nu næsten i mål med skemaet - og mon ikke der falder falder flere opgaver over mig en anden dag.

Jeg har fået "beskyt ark" og "gemmefunktionen" til at virke, så det er rigtig godt.

Sidste udfordringer (måske?) :

1)Skemaet skal sendes pr mail, brugeren skal udfylde, gemme og sende retur.

Filen de modtog må ikke bruges igen... kan jeg sætte en "destroy" på den - så den ikke kan udfyldes igen og igen - og hvordan??? -

2) ved brug af Raasten makro gemmer den. Hvis jeg trykker 2.gang på knappen spørger den om "overskriv fil" - ved svar "nej" fejler den! - hjælp modtages gerne (skal den evt. tjekke om filen findes i forvejen... og hvad så??)

Weiss

Besked fra: rassten
Posteringsdato: 26.Mar.2011 kl. 02:45

1.
Denne udvidelse af tidligere, ser på sidste spørge ark, hvis alle spørgsmål er udfyldt vil filen lukke med det samme den bliver åbnet.


Private Sub Workbook_Open()
ActiveWindow.DisplayWorkbookTabs = False
Worksheets("Ark1").Activate
 'Application.WindowState = xlMaximized

Application.DisplayAlerts = False
If Worksheets("Ark4").Range("K14") = 4 Then
ActiveWorkbook.Close
End If
Application.DisplayAlerts = True
End Sub

Pas på med at teste, du risikere netop at makroen vil lukke filen ned og hvis åbner den igen - lukker den.

2.


Sub GemSkrivebord()
BN = "PEP_" & Worksheets("Ark1").Range("A1")

Application.DisplayAlerts = False

ActiveWorkbook.SaveAs Filename:= _
        CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & BN & ".xls", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
        
Application.DisplayAlerts = True
End Sub

uploads/107/Sp%C3%B8rgeskema-33.xls - uploads/107/Spørgeskema-33.xls

-------------
VH rassten

Arbejde excel 2010
Privat excel 2010

Besked fra: Weiss
Posteringsdato: 26.Mar.2011 kl. 11:14

nr 2; har jeg nu fået til at virke, som jeg ser det - så overskriver den bare filen på skrivebord hvis der trykkes gem flere gange - FINT!

nr 1; tak for advarslen, lavede en kopi og arbejdede videre på - Det virker fint at den ikke kan åbnes igen hvis alle spg er udfyldt. Når de så skal maile den tilbage til mig, så er der problemet at den ikke vil åbnes.

Så har jeg prøvet at starte den op uden makroer, fjerne koden, og kan så se resultatet.

Kan jeg sætte kode på om bruger fx må åbne "kontrolelementer" lige som jeg har arkbeskyttelse...?

Det løser dog ikke mit problem helt - de kan stadig beholde startfilen i deres mail og prøve igen.

Alternativtet er at lave det som et link til et skema - og udlevere en adgangskode der har begrænset tid på(men så er jeg vist ud over mine egne evner...)

Har idéer nok - men mangler erfaringen...

Weiss

Besked fra: rassten
Posteringsdato: 26.Mar.2011 kl. 12:43

2. Du kan password beskytte vba koden. I vba editor, ->Tools ->VBAProject Properties ->Protection, skriv password 2 gang.
På den måde kan du undgå at andre starter filen uden makroer, ændre i kode, gemmer og derfor kan starte skemaet flere gange.

Jeg kender ikke til nogen makro som kan gå i andres mailbox og slette mail. Og selv hvis jeg gjorde, tror jeg at dette vil være et brud på retningslinierne for dette forum, en sådan makro kan bruges destruktivt.

Link til et skema? er du ude i noget med et online skema. Det er vist ud over hvad excel 2003 og 2007 kan klare, 2010 har vist noget med en cloud mulighed, men det kender jeg ikke så meget til.
Ellers er der selvfølgelig web baseret spørgeskema. Der er også den unavngivet internet tjeneste som primært er en søgeside, men også har andre tilbud, blandt andet online dokumenter, regneark og den slags.

Ellers kan man lave makroen til lukke skemaet, hvis man forsøger at åbne filen efter et antal dage/en bestemt dato

-------------
VH rassten

Arbejde excel 2010
Privat excel 2010

Besked fra: Weiss
Posteringsdato: 28.Mar.2011 kl. 16:18

Hej igen,

Jeg var nok ved at overveje det med onlineskema for at omgå at filen kan bruges af andre - men hvis den kan laves tidsbegrænset (altså ikke åbnes efter en bestemt dato, fx 14 dage fra nu) - for det opfylder min føromtalte "destroy"-knap.

Det skal vel lægges i "ThisWorkBook" og den på en eller anden måde tjekker datoen på den computer den er på, og nægter at starte op hvis datoen er overskredet. --- kan du hjælpe mig med det?

Det er dejligt med hjælpen her *smil*

Weiss

Besked fra: Allan
Posteringsdato: 28.Mar.2011 kl. 20:15

Hej Weiss,

Ang. dit spørgsmål om udløb, kan du måske bruge denne lille kode jeg har kreeret til formålet.

Koden gemmer en dato ved første åbning, datoen gemmes i registreringsdatabasen.

Når datoen er 14 dage gammel, lukkes arket igen uden varsel.

Brug koden 'Annuller' for at nulstille/Frigive datoen igen.

Private Sub Workbook_Open()
If GetSetting("Weiss", "Destroy", "Udløb") = "" Then SaveSetting "Weiss", "Destroy", "Udløb", Now
Udløb = Now + 14
If GetSetting("Weiss", "Destroy", "Udløb") > Udløb Then
'Koden som skal køre når agangen er lukket
Thisworkbook.Close False

Else
'Koden som skal køres hvis adgangen er OK
MsgBox "Arket er åbent"
End If
End Sub

Sub Annuller()
SaveSetting "Weiss", "Destroy", "Udløb", ""
End Sub

//Allan

Besked fra: Weiss
Posteringsdato: 28.Mar.2011 kl. 21:14

Hej Allan,

Tak for hjælpen -dejligt med en hjemmestrikket kode

Har nu sat den i min fil med +1 og ser resultatet imorgen.

Skal lige se om mit hoved er med - om jeg har forstået meningen

(er stadig grøn i Excel - men ser gode muligheder her)....

Som jeg "læser" så tjekker den om Weiss, udløb og destroy er blanke og ellers gemmes de som "now".

(skal de andet sted defineres, eller er dette nok?)

Udløb sættes "now"+antal dage til destroy.

Når filen næste gang åbnes; så tjekker den om åbningsværdien er større end udløb (og genbruger første dags "now" fordi den nu ikke er blank)- og hvis det er tilfældet nægter den åbning.

- jeg ender da med at blive smittet af alt jeres visdom herinde -

smil fra Weiss

Besked fra: Allan
Posteringsdato: 28.Mar.2011 kl. 21:30

Hej Weiss,

Det er helt korrekt forstået.

Du skal blot være opmærksom på at brugeren som udgangspunkt (Hvis de er kyndige nok) bare kan åbne arket uden Makroer, og dermed omgå koden. (Sådan er det med al VBA-kodning)

God fornøjelse med værket

//Allan

Besked fra: rassten
Posteringsdato: 29.Mar.2011 kl. 00:20

En anden måde, som er en udvidelse af tidligere


Private Sub Workbook_Open()
Dim a As Date
Dim b As Date
a = Format(Date, "dd-mm-yyyy")
b = Format("12-04-2011", "dd-mm-yyyy")

If a > b Then ThisWorkbook.Close False

ActiveWindow.DisplayWorkbookTabs = False
Worksheets("Ark1").Activate
 'Application.WindowState = xlMaximized

Application.DisplayAlerts = False
If Worksheets("Ark4").Range("K14") = 4 Then
ActiveWorkbook.Close
End If
Application.DisplayAlerts = True
End Sub

Ved at sætte b, kan du definere hvilken dag, makroen kan køre som sidste dag. Ved Allans har brugeren altid 14 dage.

Allan: genialt med Getsetting og Savesetting, igen "desværre" noget jeg ikke kendte. Men meget spændende læsning, og det er en metode, jeg vil glæde mig til, at tage med over i andre sammenhæng.

-------------
VH rassten

Arbejde excel 2010
Privat excel 2010

Besked fra: Allan
Posteringsdato: 29.Mar.2011 kl. 10:33

rassten skrev:

Allan: genialt med Getsetting og Savesetting, igen "desværre" noget jeg ikke kendte. Men meget spændende læsning, og det er en metode, jeg vil glæde mig til, at tage med over i andre sammenhæng.

Den giver fantastiske muligheder.

Jeg har tidligere brugt ini og txt til at lagre oplysninger udenfor Excel, men disse 2 er virkelig lækre at arbejde med.

Data gemmes i HKEY_CURRENT_USER\Software\VB and VBA Program Settings og reagerer vild hurtigt.

Det irriterer mig grænseløst at jeg ikke har sat mig ind i det noget før

//Allan

Besked fra: Weiss
Posteringsdato: 30.Mar.2011 kl. 07:06

ØV ØV

Jeg lavede koden mandag aften - og ville så lige tjekke her til morgen! (satte blot 1 istedet for 14 pga min tålmodighed)

Private Sub Workbook_Open()
ActiveWindow.DisplayWorkbookTabs = True

If GetSetting("Weiss", "Destroy", "Udløb") = "" Then SaveSetting "Weiss", "Destroy", "Udløb", Now
Udløb = Now + 1
If GetSetting("Weiss", "Destroy", "Udløb") > Udløb Then
    'Koden som skal køre når adgangen er lukket
    ThisWorkbook.Close False
Else
    'Koden som skal køres hvis adgangen er OK
    MsgBox "Arket er åbent"
End If

End Sub
-

og forventede ikke at få lov at åbne filen - men den sagde bare "arket er åbent" som den også gjorde igår og jeg har desværre intet problem med at bruge arket.

Hjælp ønskes

Weiss

Besked fra: Allan
Posteringsdato: 30.Mar.2011 kl. 13:20

Hej Weiss,

Det kan jeg godt se..... fejlen ligger i koden kan jeg se... uha.

Prøv denne i stedet:

Private Sub Workbook_Open()
ActiveWindow.DisplayWorkbookTabs = True

If GetSetting("Weiss", "Destroy", "Åbnet") = "" Then
SaveSetting "Weiss", "Destroy", "Åbnet", Now
SaveSetting "Weiss", "Destroy", "Udløb", Now + 1
End If

If Now > GetSetting("Weiss", "Destroy", "Udløb") Then
    'Koden som skal køre når adgangen er lukket
    ThisWorkbook.Close False
Else
    'Koden som skal køres hvis adgangen er OK
    MsgBox "Arket er åbent"
End If

End Sub

Sub Annuller()
SaveSetting "Weiss", "Destroy", "Åbnet", ""
SaveSetting "Weiss", "Destroy", "Udløb", ""
End Sub

Besked fra: Weiss
Posteringsdato: 31.Mar.2011 kl. 10:03

Jubiii - Så virker det! Jeg har tilføjet en Msg box der fortæller brugeren at skemaet er udløbet/ugyldigt. - er det nødvendigt med ms " MsgBox "Arket er åbent" eller kan det fjernes uden at forstyrre if/else koder.

Findes der en kode (mon ikke der gør....) der gør at ingen celler er i focus når den skifter mellem ark - som det er nu har jeg sat "curseren" i A1 bare for at den ikke irriterer mit øje.... (for ellers vælger den bare en celle der er ulåst).

Vedr Sub Annuler() ; tænker om jeg skal lave en knap der aktiverer det.

Det er en fil der skal bruges i perioder, fx nu sendes ud til 20 personer som får 14 dage til at svare - efter fx 2 måneder det samme igen til nye personer, er det så dér jeg skal lave noget Sub annuller for at resette datoen? - og kan jeg skjule knappen så det kun er mig der kan gøre det?

I et indlæg længere oppe skrev raasten at man kan sætte password på vba editor - kan det løse problemet som du (Allan) omtalte tidligere :

"Du skal blot være opmærksom på at brugeren som udgangspunkt (Hvis de er kyndige nok) bare kan åbne arket uden Makroer, og dermed omgå koden. (Sådan er det med al VBA-kodning)".

Hilsen spørge-jørgen Weiss

Besked fra: Allan
Posteringsdato: 01.Apr.2011 kl. 21:35

Weiss skrev:

Jubiii - Så virker det! Jeg har tilføjet en Msg box der fortæller brugeren at skemaet er udløbet/ugyldigt. - er det nødvendigt med ms " MsgBox "Arket er åbent" eller kan det fjernes uden at forstyrre if/else koder.

Du kan bare fjerne det, det var kun et eksempel for at visualisere funktionen.

Weiss skrev:

Vedr Sub Annuler() ; tænker om jeg skal lave en knap der aktiverer det.

Du kan godt lave en passwordbeskyttet knap til dette, et forslag med password 123 kunne være:

Sub Annuller()
Pass = InputBox("Indtast Admin password")
If Pass = "123" Then
SaveSetting "Weiss", "Destroy", "Åbnet", ""
SaveSetting "Weiss", "Destroy", "Udløb", ""
End If
End Sub

Weiss skrev:

I et indlæg længere oppe skrev raasten at man kan sætte password på vba editor - kan det løse problemet som du (Allan) omtalte tidligere :

"Du skal blot være opmærksom på at brugeren som udgangspunkt (Hvis de er kyndige nok) bare kan åbne arket uden Makroer, og dermed omgå koden. (Sådan er det med al VBA-kodning)".

Ja, du kan godt beskytte VBA-koden med ovenstående begrænsninger.

Højreklik på enten et ark, et modul eller THISWORKBOOK.
Klik på 'VBAProject properties'
Vælg fanen 'Protection'
Sæt markering i 'Lock project for Vieving'
Tast og gentag password nederst.
Klik OK.

Næste gang du åbner filen er projektet låst.

//Allan

[/QUOTE]

Print side | Luk vindue