Søg
Avatar billede skaanning Seniormester
10. oktober 2014 - 06:26 Der er 9 kommentarer og
1 løsning

Gemme data fra en usersorm

Hej jeg har en userform som jeg bruger i en personaleforening, hvis folk bestiller billetter osv., jeg lavet en gem funktion som virker for sin vis fint men, den er meget langsom, så er det at jeg ville høre om det var muligt at bruge et array til at tilføje og gemme disse data? og selvfølgelig hvordan:)
Avatar billede kabbak Professor
10. oktober 2014 - 07:09 #1
Må vi se gemme koden
Avatar billede skaanning Seniormester
10. oktober 2014 - 09:21 #2
Jep det må den er her!

Private Sub Cmb_Gem_Click()
Dim CF As String, Datafil As String, DataArk As String
    Application.ScreenUpdating = False
    Me.ListB_søgResultat.Clear
    Me.ListB_søgResultat.ColumnHeads = True
    Datafil = "bestillingsoversigt.xlsm"    ' Filnavnet på gemmefilen
    DataArk = "Data"    ' Navnet på opslagsarket
    If Not WorkbookIsOpen(Datafil) Then
        Workbooks.Open Filename:="Y:\Personaleforeningen" & "\" & Datafil
       
    Else
        Windows(Datafil).Activate
    End If
    DataArk = Me.Combo_arangementer.Text
    If Me.TxB_Bio.Value = "" Then
        MsgBox ("husk antal billetter")
        Exit Sub
        End If
  If Me.Combo_arangementer.Value = "Bio" Then
   
    Sheets(DataArk).Select
      ActiveSheet.Range("a3").Select
    Do
    If IsEmpty(ActiveCell) = False Then
        ActiveCell.Offset(1, 0).Select
    End If
    Loop Until IsEmpty(ActiveCell) = True
   
    ActiveCell.Value = Me.TextB_Dato_tid.Value
        ActiveCell.Value = Me.TextB_Dato_tid.Value
        ActiveCell.Offset(0, 1).Value = Me.ComB_Mdr.Value
        ActiveCell.Offset(0, 2).Value = Me.LabelInitialer.Caption
        ActiveCell.Offset(0, 3).Value = Me.Labe_SapId.Caption
        ActiveCell.Offset(0, 4).Value = Me.Label_Time_Funk.Caption
        ActiveCell.Offset(0, 5).Value = Me.Label_B_U
        ActiveCell.Offset(0, 6).Value = Me.Label_Navn
        ActiveCell.Offset(0, 7).Value = Me.Label_EfterNavn
        ActiveCell.Offset(0, 8).Value = Me.ComboB_BioValg.Value
        ActiveCell.Offset(0, 9).Value = Me.TxB_Bio.Value
        ActiveCell.Offset(0, 10).Value = Me.TxB_Guf.Value
        'ActiveCell.Offset(0, 11).Value = Me.ComboB_Dato.Value
        ActiveCell.Offset(0, 12).Value = Me.ComboB_Tider.Value
        ActiveCell.Offset(0, 13).Value = Me.ComB_Mdr.Value
        ActiveCell.Offset(0, 14).Value = Me.Label_Dag_nat
        ActiveCell.Offset(0, 15).Value = Me.ComboB_Initialer.Value
        'ActiveCell.Offset(0, 18).Value = Me.combPris.Value
        ActiveCell.Offset(0, 21).Value = Me.Combo_arangementer.Value
        ActiveCell.Offset(0, 22).Value = "1"
       
       
       
          Sheets("Status").Select
      ActiveSheet.Range("a3").Select
    Do
    If IsEmpty(ActiveCell) = False Then
        ActiveCell.Offset(1, 0).Select
    End If
    Loop Until IsEmpty(ActiveCell) = True
   
   
        ActiveCell.Value = Me.TextB_Dato_tid.Value
        ActiveCell.Offset(0, 1).Value = Me.ComB_Mdr.Value
        ActiveCell.Offset(0, 2).Value = Me.LabelInitialer.Caption
        ActiveCell.Offset(0, 3).Value = Me.Labe_SapId.Caption
        ActiveCell.Offset(0, 4).Value = Me.Label_Time_Funk.Caption
        ActiveCell.Offset(0, 5).Value = Me.Label_B_U
        ActiveCell.Offset(0, 6).Value = Me.Label_Navn
        ActiveCell.Offset(0, 7).Value = Me.Label_EfterNavn
        ActiveCell.Offset(0, 8).Value = Me.lblArrangement.Caption
        ActiveCell.Offset(0, 9).Value = Me.TxB_Bio.Value
        ActiveCell.Offset(0, 10).Value = Me.TxB_Guf.Value
        'ActiveCell.Offset(0, 11).Value = Me.ComboB_Dato.Value
        ActiveCell.Offset(0, 12).Value = Me.ComboB_Tider.Value
        ActiveCell.Offset(0, 13).Value = Me.ComB_Mdr.Value
        ActiveCell.Offset(0, 14).Value = Me.Label_Dag_nat
        ActiveCell.Offset(0, 15).Value = Me.ComboB_Initialer.Value
        ActiveCell.Offset(0, 21).Value = Me.Combo_arangementer.Value
        ActiveCell.Offset(0, 22).Value = "1"
    Else
    Sheets(DataArk).Select
    ActiveSheet.Range("a2").Select
   
    Do
    If IsEmpty(ActiveCell) = False Then
        ActiveCell.Offset(1, 0).Select
    End If
    Loop Until IsEmpty(ActiveCell) = True
    'Me.ComB_Mdr.Visible = True Then
    ActiveCell.Value = Me.TextB_Dato_tid.Value
        ActiveCell.Offset(0, 1).Value = Me.ComB_Mdr.Value
        ActiveCell.Offset(0, 2).Value = Me.LabelInitialer.Caption
        ActiveCell.Offset(0, 3).Value = Me.Labe_SapId.Caption
        ActiveCell.Offset(0, 4).Value = Me.Label_Time_Funk.Caption
        ActiveCell.Offset(0, 5).Value = Me.Label_B_U
        ActiveCell.Offset(0, 6).Value = Me.Label_Navn
        ActiveCell.Offset(0, 7).Value = Me.Label_EfterNavn
        ActiveCell.Offset(0, 8).Value = Me.lblArrangement.Caption
        ActiveCell.Offset(0, 9).Value = Me.TxB_Bio.Value
        ActiveCell.Offset(0, 10).Value = Me.TxB_Guf.Value
        ActiveCell.Offset(0, 11).Value = Me.ComboB_Dato.Value
        ActiveCell.Offset(0, 12).Value = Me.ComboB_Tider.Value
        ActiveCell.Offset(0, 13).Value = Me.ComB_Mdr.Value
        ActiveCell.Offset(0, 14).Value = Me.Label_Dag_nat
        ActiveCell.Offset(0, 15).Value = Me.ComboB_Initialer.Value
        'ActiveCell.Offset(0, 18).Value = Me.combPris.Value
        ActiveCell.Offset(0, 21).Value = Me.Combo_arangementer.Value
        ActiveCell.Offset(0, 22).Value = "1"
        ActiveCell.Offset(0, 24).Value = Me.txb_0Til11.Value
        ActiveCell.Offset(0, 25).Value = Me.txb_12Til15.Value
       
       
  Sheets("Status").Select
      ActiveSheet.Range("a3").Select
    Do
    If IsEmpty(ActiveCell) = False Then
        ActiveCell.Offset(1, 0).Select
    End If
    Loop Until IsEmpty(ActiveCell) = True
   
   
        ActiveCell.Value = Me.TextB_Dato_tid.Value
        ActiveCell.Offset(0, 1).Value = Me.ComB_Mdr.Value
        ActiveCell.Offset(0, 2).Value = Me.LabelInitialer.Caption
        ActiveCell.Offset(0, 3).Value = Me.Labe_SapId.Caption
        ActiveCell.Offset(0, 4).Value = Me.Label_Time_Funk.Caption
        ActiveCell.Offset(0, 5).Value = Me.Label_B_U
        ActiveCell.Offset(0, 6).Value = Me.Label_Navn
        ActiveCell.Offset(0, 7).Value = Me.Label_EfterNavn
        ActiveCell.Offset(0, 8).Value = Me.lblArrangement.Caption
        ActiveCell.Offset(0, 9).Value = Me.TxB_Bio.Value
        ActiveCell.Offset(0, 10).Value = Me.TxB_Guf.Value
        'ActiveCell.Offset(0, 11).Value = Me.ComboB_Dato.Value
        ActiveCell.Offset(0, 12).Value = Me.ComboB_Tider.Value
        ActiveCell.Offset(0, 13).Value = Me.ComB_Mdr.Value
        ActiveCell.Offset(0, 14).Value = Me.Label_Dag_nat
        ActiveCell.Offset(0, 15).Value = Me.ComboB_Initialer.Value
        ActiveCell.Offset(0, 21).Value = Me.Combo_arangementer.Value
        ActiveCell.Offset(0, 22).Value = "1"
        ActiveCell.Offset(0, 24).Value = Me.txb_0Til11.Value
        ActiveCell.Offset(0, 25).Value = Me.txb_12Til15.Value
     
      End If
     
        'Application.ScreenUpdating = True
     
      ActiveWorkbook.Close True
   
      Call HentDataTjek
     
        'Call billetstatestikOpdate
     
      svar = MsgBox("Vil du udlevere", vbYesNo, "Udlevering")
        If svar = vbYes Then
        Call ComB_Udlevering_Click
        Else
            Me.CheckB_udlevering.Value = False
            Me.Combo_arangementer.Value = "?"
            Me.ComB_Mdr.Visible = False
          Me.Frame_BilletKøb.Visible = False
          Me.Combo_By_April.Visible = False
          Me.ComboB_Dato.Visible = False
          Me.combPris.Visible = False
          Me.lblArrangement.Caption = ""
          Me.ComboB_BioValg.Visible = False
          Me.Txb_søgefeltEfterNavn = ""
          Me.Txb_søgefeltLønNr = ""
          Me.Txb_søgefeltNavn = ""
          Me.Txb_søgefeltSapId = ""
          Me.Combo_By_April.Value = ""
          'Me.ListB_søgResultat.Visible = True
         
         
        Call BilletStatus
        Call billetTjek
        Me.Frame_Statestik.Visible = True
            Exit Sub
        End If
 
 
End Sub
Avatar billede kabbak Professor
10. oktober 2014 - 10:05 #3
Private Sub Cmb_Gem_Click()
    Dim CF As String, Datafil As String, DataArk As String
    Application.ScreenUpdating = False
    Me.ListB_søgResultat.Clear
    Me.ListB_søgResultat.ColumnHeads = True
    Datafil = "bestillingsoversigt.xlsm"    ' Filnavnet på gemmefilen
    DataArk = "Data"    ' Navnet på opslagsarket
    If Not WorkbookIsOpen(Datafil) Then
        Workbooks.Open Filename:="Y:\Personaleforeningen" & "\" & Datafil

    Else
        Windows(Datafil).Activate
    End If
    DataArk = Me.Combo_arangementer.Text
    If Me.TxB_Bio.Value = "" Then
        MsgBox ("husk antal billetter")
        Exit Sub
    End If
    If Me.Combo_arangementer.Value = "Bio" Then

        Sheets(DataArk).Select
        ActiveSheet.Range("a3").Select
        Do
            If IsEmpty(ActiveCell) = False Then
                ActiveCell.Offset(1, 0).Select
            End If
        Loop Until IsEmpty(ActiveCell) = True

        ActiveCell.Value = Me.TextB_Dato_tid.Value
        ActiveCell.Value = Me.TextB_Dato_tid.Value
        ActiveCell.Offset(0, 1).Value = Me.ComB_Mdr.Value
        ActiveCell.Offset(0, 2).Value = Me.LabelInitialer.Caption
        ActiveCell.Offset(0, 3).Value = Me.Labe_SapId.Caption
        ActiveCell.Offset(0, 4).Value = Me.Label_Time_Funk.Caption
        ActiveCell.Offset(0, 5).Value = Me.Label_B_U
        ActiveCell.Offset(0, 6).Value = Me.Label_Navn
        ActiveCell.Offset(0, 7).Value = Me.Label_EfterNavn
        ActiveCell.Offset(0, 8).Value = Me.ComboB_BioValg.Value
        ActiveCell.Offset(0, 9).Value = Me.TxB_Bio.Value
        ActiveCell.Offset(0, 10).Value = Me.TxB_Guf.Value
        'ActiveCell.Offset(0, 11).Value = Me.ComboB_Dato.Value
        ActiveCell.Offset(0, 12).Value = Me.ComboB_Tider.Value
        ActiveCell.Offset(0, 13).Value = Me.ComB_Mdr.Value
        ActiveCell.Offset(0, 14).Value = Me.Label_Dag_nat
        ActiveCell.Offset(0, 15).Value = Me.ComboB_Initialer.Value
        'ActiveCell.Offset(0, 18).Value = Me.combPris.Value
        ActiveCell.Offset(0, 21).Value = Me.Combo_arangementer.Value
        ActiveCell.Offset(0, 22).Value = "1"



        Sheets("Status").Select
        ActiveSheet.Range("a3").Select
        Do
            If IsEmpty(ActiveCell) = False Then
                ActiveCell.Offset(1, 0).Select
            End If
        Loop Until IsEmpty(ActiveCell) = True


        ActiveCell.Value = Me.TextB_Dato_tid.Value
        ActiveCell.Offset(0, 1).Value = Me.ComB_Mdr.Value
        ActiveCell.Offset(0, 2).Value = Me.LabelInitialer.Caption
        ActiveCell.Offset(0, 3).Value = Me.Labe_SapId.Caption
        ActiveCell.Offset(0, 4).Value = Me.Label_Time_Funk.Caption
        ActiveCell.Offset(0, 5).Value = Me.Label_B_U
        ActiveCell.Offset(0, 6).Value = Me.Label_Navn
        ActiveCell.Offset(0, 7).Value = Me.Label_EfterNavn
        ActiveCell.Offset(0, 8).Value = Me.lblArrangement.Caption
        ActiveCell.Offset(0, 9).Value = Me.TxB_Bio.Value
        ActiveCell.Offset(0, 10).Value = Me.TxB_Guf.Value
        'ActiveCell.Offset(0, 11).Value = Me.ComboB_Dato.Value
        ActiveCell.Offset(0, 12).Value = Me.ComboB_Tider.Value
        ActiveCell.Offset(0, 13).Value = Me.ComB_Mdr.Value
        ActiveCell.Offset(0, 14).Value = Me.Label_Dag_nat
        ActiveCell.Offset(0, 15).Value = Me.ComboB_Initialer.Value
        ActiveCell.Offset(0, 21).Value = Me.Combo_arangementer.Value
        ActiveCell.Offset(0, 22).Value = "1"
    Else
        Sheets(DataArk).Select
        ActiveSheet.Range("a2").Select

        Do
            If IsEmpty(ActiveCell) = False Then
                ActiveCell.Offset(1, 0).Select
            End If
        Loop Until IsEmpty(ActiveCell) = True
        'Me.ComB_Mdr.Visible = True Then
        ActiveCell.Value = Me.TextB_Dato_tid.Value
        ActiveCell.Offset(0, 1).Value = Me.ComB_Mdr.Value
        ActiveCell.Offset(0, 2).Value = Me.LabelInitialer.Caption
        ActiveCell.Offset(0, 3).Value = Me.Labe_SapId.Caption
        ActiveCell.Offset(0, 4).Value = Me.Label_Time_Funk.Caption
        ActiveCell.Offset(0, 5).Value = Me.Label_B_U
        ActiveCell.Offset(0, 6).Value = Me.Label_Navn
        ActiveCell.Offset(0, 7).Value = Me.Label_EfterNavn
        ActiveCell.Offset(0, 8).Value = Me.lblArrangement.Caption
        ActiveCell.Offset(0, 9).Value = Me.TxB_Bio.Value
        ActiveCell.Offset(0, 10).Value = Me.TxB_Guf.Value
        ActiveCell.Offset(0, 11).Value = Me.ComboB_Dato.Value
        ActiveCell.Offset(0, 12).Value = Me.ComboB_Tider.Value
        ActiveCell.Offset(0, 13).Value = Me.ComB_Mdr.Value
        ActiveCell.Offset(0, 14).Value = Me.Label_Dag_nat
        ActiveCell.Offset(0, 15).Value = Me.ComboB_Initialer.Value
        'ActiveCell.Offset(0, 18).Value = Me.combPris.Value
        ActiveCell.Offset(0, 21).Value = Me.Combo_arangementer.Value
        ActiveCell.Offset(0, 22).Value = "1"
        ActiveCell.Offset(0, 24).Value = Me.txb_0Til11.Value
        ActiveCell.Offset(0, 25).Value = Me.txb_12Til15.Value


        Sheets("Status").Select
        ActiveSheet.Range("a3").Select
        Do
            If IsEmpty(ActiveCell) = False Then
                ActiveCell.Offset(1, 0).Select
            End If
        Loop Until IsEmpty(ActiveCell) = True


        ActiveCell.Value = Me.TextB_Dato_tid.Value
        ActiveCell.Offset(0, 1).Value = Me.ComB_Mdr.Value
        ActiveCell.Offset(0, 2).Value = Me.LabelInitialer.Caption
        ActiveCell.Offset(0, 3).Value = Me.Labe_SapId.Caption
        ActiveCell.Offset(0, 4).Value = Me.Label_Time_Funk.Caption
        ActiveCell.Offset(0, 5).Value = Me.Label_B_U
        ActiveCell.Offset(0, 6).Value = Me.Label_Navn
        ActiveCell.Offset(0, 7).Value = Me.Label_EfterNavn
        ActiveCell.Offset(0, 8).Value = Me.lblArrangement.Caption
        ActiveCell.Offset(0, 9).Value = Me.TxB_Bio.Value
        ActiveCell.Offset(0, 10).Value = Me.TxB_Guf.Value
        'ActiveCell.Offset(0, 11).Value = Me.ComboB_Dato.Value
        ActiveCell.Offset(0, 12).Value = Me.ComboB_Tider.Value
        ActiveCell.Offset(0, 13).Value = Me.ComB_Mdr.Value
        ActiveCell.Offset(0, 14).Value = Me.Label_Dag_nat
        ActiveCell.Offset(0, 15).Value = Me.ComboB_Initialer.Value
        ActiveCell.Offset(0, 21).Value = Me.Combo_arangementer.Value
        ActiveCell.Offset(0, 22).Value = "1"
        ActiveCell.Offset(0, 24).Value = Me.txb_0Til11.Value
        ActiveCell.Offset(0, 25).Value = Me.txb_12Til15.Value

    End If

    'Application.ScreenUpdating = True

    ActiveWorkbook.Close True

    Call HentDataTjek

    'Call billetstatestikOpdate

    svar = MsgBox("Vil du udlevere", vbYesNo, "Udlevering")
    If svar = vbYes Then
        Call ComB_Udlevering_Click
    Else
        Me.CheckB_udlevering.Value = False
        Me.Combo_arangementer.Value = "?"
        Me.ComB_Mdr.Visible = False
        Me.Frame_BilletKøb.Visible = False
        Me.Combo_By_April.Visible = False
        Me.ComboB_Dato.Visible = False
        Me.combPris.Visible = False
        Me.lblArrangement.Caption = ""
        Me.ComboB_BioValg.Visible = False
        Me.Txb_søgefeltEfterNavn = ""
        Me.Txb_søgefeltLønNr = ""
        Me.Txb_søgefeltNavn = ""
        Me.Txb_søgefeltSapId = ""
        Me.Combo_By_April.Value = ""
        'Me.ListB_søgResultat.Visible = True


        Call BilletStatus
        Call billetTjek
        Me.Frame_Statestik.Visible = True
        Exit Sub
    End If


End Sub
Avatar billede kabbak Professor
10. oktober 2014 - 10:06 #4
det var den forkerte, her er den rigtige

Private Sub Cmb_Gem_Click()
Dim CF As String, Datafil As String, DataArk As String, RW As Long
    Application.ScreenUpdating = False
    Me.ListB_søgResultat.Clear
    Me.ListB_søgResultat.ColumnHeads = True
    Datafil = "bestillingsoversigt.xlsm"    ' Filnavnet på gemmefilen
    DataArk = "Data"    ' Navnet på opslagsarket
    If Not WorkbookIsOpen(Datafil) Then
        Workbooks.Open Filename:="Y:\Personaleforeningen" & "\" & Datafil
       
    Else
        Windows(Datafil).Activate
    End If
   
    DataArk = Me.Combo_arangementer.Text
   
    If Me.TxB_Bio.Value = "" Then
        MsgBox ("husk antal billetter")
        Exit Sub
        End If
  If Me.Combo_arangementer.Value = "Bio" Then
   
    Sheets(DataArk).Select
    RW = ActiveSheet.Range("a3").End(xlDown).Row + 1
'    Do
'    If IsEmpty(ActiveCell) = False Then
'      cells(1, 0).Select
'    End If
'    Loop Until IsEmpty(ActiveCell) = True
'
    ActiveCell.Value = Me.TextB_Dato_tid.Value
      Cells(RW, 1).Value = Me.TextB_Dato_tid.Value
      Cells(RW, 2).Value = Me.ComB_Mdr.Value
      Cells(RW, 3).Value = Me.LabelInitialer.Caption
      Cells(RW, 4).Value = Me.Labe_SapId.Caption
      Cells(RW, 5).Value = Me.Label_Time_Funk.Caption
      Cells(RW, 6).Value = Me.Label_B_U
      Cells(RW, 7).Value = Me.Label_Navn
      Cells(RW, 8).Value = Me.Label_EfterNavn
      Cells(RW, 9).Value = Me.ComboB_BioValg.Value
      Cells(RW, 10).Value = Me.TxB_Bio.Value
      Cells(RW, 11).Value = Me.TxB_Guf.Value
        'ActiveCell.Offset(rw, 11).Value = Me.ComboB_Dato.Value
      Cells(RW, 13).Value = Me.ComboB_Tider.Value
      Cells(RW, 14).Value = Me.ComB_Mdr.Value
      Cells(RW, 15).Value = Me.Label_Dag_nat
      Cells(RW, 16).Value = Me.ComboB_Initialer.Value
        'ActiveCell.Offset(rw, 18).Value = Me.combPris.Value
      Cells(RW, 22).Value = Me.Combo_arangementer.Value
      Cells(RW, 23).Value = "1"
       
          Sheets("Status").Select
'      ActiveSheet.Range("a3").Select
'    Do
'    If IsEmpty(ActiveCell) = False Then
'      cells(1, 0).Select
'    End If
'    Loop Until IsEmpty(ActiveCell) = True
    RW = ActiveSheet.Range("a3").End(xlDown).Row + 1
   
        Cells(RW, 1).Value = Me.TextB_Dato_tid.Value
      Cells(RW, 2).Value = Me.ComB_Mdr.Value
      Cells(RW, 3).Value = Me.LabelInitialer.Caption
      Cells(RW, 4).Value = Me.Labe_SapId.Caption
      Cells(RW, 5).Value = Me.Label_Time_Funk.Caption
      Cells(RW, 6).Value = Me.Label_B_U
      Cells(RW, 7).Value = Me.Label_Navn
      Cells(RW, 8).Value = Me.Label_EfterNavn
      Cells(RW, 9).Value = Me.lblArrangement.Caption
      Cells(RW, 10).Value = Me.TxB_Bio.Value
      Cells(RW, 11).Value = Me.TxB_Guf.Value
        'ActiveCell.Offset(rw, 11).Value = Me.ComboB_Dato.Value
      Cells(RW, 13).Value = Me.ComboB_Tider.Value
      Cells(RW, 14).Value = Me.ComB_Mdr.Value
      Cells(RW, 15).Value = Me.Label_Dag_nat
      Cells(RW, 16).Value = Me.ComboB_Initialer.Value
      Cells(RW, 22).Value = Me.Combo_arangementer.Value
      Cells(RW, 23).Value = "1"
    Else
   
    Sheets(DataArk).Select
'    ActiveSheet.Range("a2").Select
'
'    Do
'    If IsEmpty(ActiveCell) = False Then
'      cells(1, 0).Select
'    End If
'    Loop Until IsEmpty(ActiveCell) = True
      RW = ActiveSheet.Range("a2").End(xlDown).Row + 1
    'Me.ComB_Mdr.Visible = True Then
      Cells(RW, 1).Value = Me.TextB_Dato_tid.Value
      Cells(RW, 2).Value = Me.ComB_Mdr.Value
      Cells(RW, 3).Value = Me.LabelInitialer.Caption
      Cells(RW, 4).Value = Me.Labe_SapId.Caption
      Cells(RW, 5).Value = Me.Label_Time_Funk.Caption
      Cells(RW, 6).Value = Me.Label_B_U
      Cells(RW, 7).Value = Me.Label_Navn
      Cells(RW, 8).Value = Me.Label_EfterNavn
      Cells(RW, 9).Value = Me.lblArrangement.Caption
      Cells(RW, 10).Value = Me.TxB_Bio.Value
      Cells(RW, 11).Value = Me.TxB_Guf.Value
      Cells(RW, 12).Value = Me.ComboB_Dato.Value
      Cells(RW, 13).Value = Me.ComboB_Tider.Value
      Cells(RW, 14).Value = Me.ComB_Mdr.Value
      Cells(RW, 15).Value = Me.Label_Dag_nat
      Cells(RW, 16).Value = Me.ComboB_Initialer.Value
        'ActiveCell.Offset(rw, 18).Value = Me.combPris.Value
      Cells(RW, 22).Value = Me.Combo_arangementer.Value
      Cells(RW, 23).Value = "1"
      Cells(RW, 25).Value = Me.txb_0Til11.Value
      Cells(RW, 26).Value = Me.txb_12Til15.Value
       
       
'  Sheets("Status").Select
'      ActiveSheet.Range("a3").Select
'    Do
'    If IsEmpty(ActiveCell) = False Then
'      cells(1, 0).Select
'    End If
'    Loop Until IsEmpty(ActiveCell) = True
   
    RW = ActiveSheet.Range("a3").End(xlDown).Row + 1
   
      Cells(RW, 1).Value = Me.TextB_Dato_tid.Value
      Cells(RW, 2).Value = Me.ComB_Mdr.Value
      Cells(RW, 3).Value = Me.LabelInitialer.Caption
      Cells(RW, 4).Value = Me.Labe_SapId.Caption
      Cells(RW, 5).Value = Me.Label_Time_Funk.Caption
      Cells(RW, 6).Value = Me.Label_B_U
      Cells(RW, 7).Value = Me.Label_Navn
      Cells(RW, 8).Value = Me.Label_EfterNavn
      Cells(RW, 9).Value = Me.lblArrangement.Caption
      Cells(RW, 10).Value = Me.TxB_Bio.Value
      Cells(RW, 11).Value = Me.TxB_Guf.Value
        'ActiveCell.Offset(rw, 11).Value = Me.ComboB_Dato.Value
      Cells(RW, 13).Value = Me.ComboB_Tider.Value
      Cells(RW, 14).Value = Me.ComB_Mdr.Value
      Cells(RW, 15).Value = Me.Label_Dag_nat
      Cells(RW, 16).Value = Me.ComboB_Initialer.Value
      Cells(RW, 22).Value = Me.Combo_arangementer.Value
      Cells(RW, 23).Value = "1"
      Cells(RW, 25).Value = Me.txb_0Til11.Value
      Cells(RW, 26).Value = Me.txb_12Til15.Value
     
      End If
     
        'Application.ScreenUpdating = True
     
      ActiveWorkbook.Close True
   
      Call HentDataTjek
     
        'Call billetstatestikOpdate
     
      svar = MsgBox("Vil du udlevere", vbYesNo, "Udlevering")
        If svar = vbYes Then
        Call ComB_Udlevering_Click
        Else
            Me.CheckB_udlevering.Value = False
            Me.Combo_arangementer.Value = "?"
            Me.ComB_Mdr.Visible = False
          Me.Frame_BilletKøb.Visible = False
          Me.Combo_By_April.Visible = False
          Me.ComboB_Dato.Visible = False
          Me.combPris.Visible = False
          Me.lblArrangement.Caption = ""
          Me.ComboB_BioValg.Visible = False
          Me.Txb_søgefeltEfterNavn = ""
          Me.Txb_søgefeltLønNr = ""
          Me.Txb_søgefeltNavn = ""
          Me.Txb_søgefeltSapId = ""
          Me.Combo_By_April.Value = ""
          'Me.ListB_søgResultat.Visible = True
         
         
        Call BilletStatus
        Call billetTjek
        Me.Frame_Statestik.Visible = True
            Exit Sub
        End If
 
 
End Sub
Avatar billede kabbak Professor
10. oktober 2014 - 10:11 #5
fjern lige linjen

  ActiveCell.Value = Me.TextB_Dato_tid.Value
Avatar billede skaanning Seniormester
10. oktober 2014 - 11:16 #6
Hej det virker fint men om det blev ret meget hurtigere ved jeg ikke rigtigt, men det kan være alle de cal jeg laver sidst i filen, der er ikke en måde at man kan bruge de array som jeg allerede har kaldt?
Avatar billede skaanning Seniormester
10. oktober 2014 - 11:19 #7
Jeg bruger i forvejen diverse array til at hente data ind i userformen, så hvis der var en mulighed for at skrive til disse array ville det jo værre rigtigt fint,
Avatar billede kabbak Professor
10. oktober 2014 - 11:24 #8
du kan jo prøve at ud-kommenter dine Call, så kan du jo se om den bliver hurtigere.

hvis den gør det, skal vi måske se på koderne i

  Call HentDataTjek
  Call BilletStatus
  Call billetTjek
Avatar billede skaanning Seniormester
13. oktober 2014 - 06:43 #9
Hej igen jeg har prøvet at ud-kommentere disse call's men det hjælper ikke rigtigt' det der tager tid er i det der sker indtil at MSG boxen kommer frem, efter den er der ingen problemer, det kan jo også være at læse skrive hastigheden bare er for langsom til vores server:)
Avatar billede skaanning Seniormester
15. oktober 2014 - 08:10 #10
Nå der sker nok ikke mere her så smid et svar så kan du få dine point:))
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
Excel kurser
Excel kurser for alle niveauer og behov – find det kursus, der passer til dig
Se alle Excel kurser

Flere spørgsmål fra Excel kategorien

Titel Indlæg Oprettet Seneste aktivitet
Stempel ur start og stop Af lurup i Excel 1 I går 13:24 I går 21:06
Hvordan bruges indeks & sammenlign når der skal søges over flere kolonner? Af Laugesen1 i Excel 4 08/03/202611:56 08/03/202613:57
Tips til at mestre Excel hurtigt Af MonikaG32 i Excel 4 04/03/202617:11 06/03/202609:37
Båndet i Excel online har ændret størrelse Af Monique i Excel 3 19/02/202614:23 20/02/202608:26
Fjern tekst efter mellemrum Af ABE15 i Excel 2 18/02/202620:41 19/02/202611:30
Se alle spørgsmål i kategorien Opret spørgsmål

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.

Opret Log ind

Du kan også logge ind via nedenstående tjenester

Alle kategorier på Eksperten
Seneste spørgsmål Seneste aktivitet
I går 13:50 Ingen forb. fra ny pc'er til printer Af arnel i Printere
I går 13:24 Stempel ur start og stop Af lurup i Excel
21/0300:56 3 skærme 27 Af bbm i Skærme
20/0316:18 "gratis" "reklamefri" hjemmeside -næsten --som man kan lave i søvne : Af Novice-1 i Andet software
19/0316:52 Proxy router/server Af joki i Routere & Switches
White papers
Flere white papers »