Avatar billede Buggelsgaard Novice
08. december 2014 - 09:43 Der er 6 kommentarer

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?
Avatar billede supertekst Ekspert
08. december 2014 - 09:55 #1
Prøv at vise VBA-koden her..
Avatar billede Buggelsgaard Novice
08. december 2014 - 10:31 #2
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.




Sub NytFaneblad(NewNumber)
'
' NytFaneblad
'


Dim SheetName As String


    SheetName = NewNumber
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Select
    Sheets(Sheets.Count).Name = "Temp"
    Call GoerSheetSynlig("Template")
    Sheets("Template").Select
    Range("A1:AB7").Select
    Selection.Copy
    Sheets("Temp").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Rows("1:1").Select
    Selection.RowHeight = 70
    Call SkjulSheet("Template")
    Sheets("Temp").Select
    Sheets("Temp").Name = NewNumber
    Range("A7").Select
    Selection.Value = NewNumber
    Sheets(Sheets.Count).Select
    Range("A7").Select

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

Application.CutCopyMode = False                ' Ophør KlipKopier tilstand.
ActiveWorkbook.Save                            ' Gem dokumentet.

End Sub

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
Avatar billede supertekst Ekspert
08. december 2014 - 11:09 #3
Prøver at se på det..
Avatar billede supertekst Ekspert
08. december 2014 - 11:20 #4
Det er desværre nødvendigt for mig at kunne afprøve systemet for at spore de steder, som du efterlyser.

Det nuværende uddrag kan ikke køres - da der henvises til flere subrutiner, der ikke er med.

I givet fald er du velkommen til at sende hele filen. @-adresse under min profil.
Avatar billede Buggelsgaard Novice
08. december 2014 - 12:31 #5
Har fået et forslag, der hedder:

Application.DisplayAlerts = False

Det prøver vi lige...
Avatar billede supertekst Ekspert
08. december 2014 - 13:12 #6
Ok
Avatar billede Ny bruger Nybegynder

Din løsning...

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.

Loading billede Opret Preview
Kategori
Kurser inden for grundlæggende programmering

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester