Fjerne dialogboks ved lukning af et Excelark med VBA-programmering
Jeg står med et excelark, hvori der er lavet noget VBAprogrammering, der fungerer således: - Der er en knap i excelarket, hvorpå der kan oprettes en ny fane, hvori der så kan indtastes nogle data i én linje. - Når arket lukkes, så overflyttes data fra det/de nyåbnede faner til selve hovedfanen og disse nye faner slettes. dvs disse faner bruges kun som "tastemulighed", så man ikke skal taste i hovedfanen. - Når arket lukkes, så spørger Excel om jeg vil slette dataene i disse faner permanent. Det vil jeg selvfølgelig, da det er en betingelse for at de overføres til hovedfanen. - Alt dette fungerer som det skal, men jeg ønsker ikke at få disse dialogbokse, hvor man skal svare ja, for overhovedet at kunne lukke arket. Der skal ovenikøbet svares ja til at slette data permanent for HVER ny fane man har oprettet, så hvis der er oprettet 7 nye faner, så popper boksen op 7 gange, hvor man skal svare ja. Og det er ikke særligt logisk for brugere, at de skal svare ja til at slette data permanent, når de nu lige har indtastet disse data.
Hvorledes kan man undgå disse dialogbokse - eller i det mindste bare måske nøjes med én boks, der så bare siger noget andet, som f.eks. "Ønsker du at lukke dokumentet" eller lignende?
Har kopieret det relevante ind her. Der er flere bi-funktioner end det nævnte, men ikke så relevant for dette. Der er også skrevet kommentarer ved programmeringen, så disse står også blandet mellem nedenstående. Det er en kollega, der har lavet det, men er blevet syg, så skal lige forsøge at kigge lidt på det i mellemtiden, selv om jeg ikke rigtig kender til VBA.
Ved heller ikke om det er optimalt programmet, men det hele fungerer som det skal på nær et par småting, så mangler bare lige at slippe af med disse dialogbokse til at slutte af på. Selv mente han, at det var en procedure fra Excels side, som man ikke kan komme uden om, men det må nu kunne lade sig gøre.
End Sub Sub KopierDataTilListe() ' ' KopierDataTilListe: ' Så længe der er mere end de normale 3 standard faner -> ' Tæl antallet af faner -> ' Vælg fane nummer 4 -> ' Kopier indholdet af linien fra "B7" til "AB7" -> ' Find nummeret i række "A" i "Liste", der matcher nummeret i celle "A7" i fane 4 -> ' Indsæt data fra fane 4, til højre for det matchende nummer i "Liste" -> ' Slet fane 4 -> ' Gem dokumentet. ' Dim Length As Long Dim NewInputCell As String Dim MySheet, FindNumber As Variant
If Sheets.Count > 3 Then ' Hvis der er mere end 3 Faner ("Liste" & "Template").
MySheet = 4 ' Sæt tæller-variablen "i", så den peger på første brugergenererede fane.
While MySheet <= Sheets.Count ' Så længe antallet af faner (inklusiv de skjulte), er mindre end eller li med 4, gøres følgende: Sheets(MySheet).Select ' Vælg fane nr. 4, via variablen MySheet. Range("A7").Select ' Sæt fokus i cellen "A7". FindNumber = Selection.Value ' Læg indholdet af cellen "A7" i variablen "FindNumber". Range("B7:AB7").Select ' Marker cellerne "B7" til "AB7". Selection.Copy ' Kopier de markerede celler. 'Application.CutCopyMode = False ' Ophør KlipKopier tilstand. Sheets("Liste").Select ' Vælg fanen "Liste".
With Worksheets("Liste").Range("a6:a400") ' Vælg cellerne "A6" til "A400" i fanen "Liste", som område for afvikling af følgende: Set c = .Find(FindNumber, LookIn:=xlValues) ' Opret variablen "C" og læg resultatet af følgende spørgsmål i den: Hvilken celle i området "A6" til "A400" fra fanen "Liste", indeholder det samme som variablen "FindNumber"? firstaddress = c.Address ' Opret variablen "firstaddress", og læg adressen på den matchende celle i den. Length = Len(firstaddress) ' Find længden på indholdet af variablen "firstaddress" (mellem 4 og 6 pladser - "$A$6" til "$A$400"), og læg resultatet i variablen "Length". Length = Length - 3 ' Træk tre fra indholdet af variablen "Length". NewInputCell = "B" & Right(firstaddress, Length) ' Slet "$A$" fra variablen "firstadress", så der kun er et tal mellem 6 & 400 tilbage. Sæt bogstavet "B" efterfulgt af dette tal ind i variablen "NewInputCell". Range(NewInputCell).Select ' Marker, via variablen "NewInputCell", cellen hvor data skal indsættes. ActiveSheet.Paste ' Indsæt kopierede data. End With
MySheet = MySheet + 1 'Sheets(MySheet).Select ' Vælg fane nr. 4, via variablen MySheet. 'Call LaasOpWorkbook 'Sheets(MySheet).Delete ' Slet fane nr. 4. 'Call LaasWorkbook 'Sheets("Liste").Select ' Vælg fanen "Liste". 'ActiveWorkbook.Save ' Gem dokumentet. Wend End If
Sub OpdaterListeKopi() ' ' OpdaterListeKopi ' Sheets("Liste - KOPI").Select Range("A1:AB400").Select Selection.Delete Shift:=xlUp Sheets("Liste").Select Range("A1:AB400").Select Selection.Copy Sheets("Liste - KOPI").Select Range("A1:AB400").Select ActiveSheet.Paste Range("A6").Select ActiveWorkbook.Save Sheets("Liste").Select Range("A6").Select Application.CutCopyMode = False ActiveWorkbook.Save End Sub
Sub OpdaterAlt() Dim ProtectionCode As String Call HentKode(ProtectionCode) Call LaasOpSheet("Liste", ProtectionCode) Call SorterFaldende Call KopierDataTilLliste Call OpdaterListeKopi Call LaasSheet("Liste", ProtectionCode) Call FilterListeKopi_TIL Sheets("Liste - KOPI").Select ' Vælg fanen "Liste". Range("A7").Select ' Sæt fokus i cellen "A7". End Sub
Sub SletNyeFaner() Dim Length As Long Dim NewInputCell As String Dim MySheet, FindNumber, Responce As Variant
If Sheets.Count > 3 Then ' Hvis der er mere end 3 Faner ("Liste" & "Template").
MySheet = 4 ' Sæt tæller-variablen "i", så den peger på første brugergenererede fane. Call LaasOpWorkbook
While MySheet <= Sheets.Count ' Så længe antallet af faner (inklusiv de skjulte), er mindre end eller li med 4, gøres følgende: Sheets(MySheet).Select ' Vælg fane nr. 4, via variablen MySheet. Responce = Sheets(MySheet).Delete ' Slet fane nr. 4. ActiveWorkbook.Save ' Gem dokumentet. Wend Call LaasWorkbook End If ActiveWorkbook.Save ' Gem dokumentet. End Sub
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
