Excel-skript på jobb

[tsunammi2k]

Private Sub CommandButton1_Click()

ttekst = "Er rådata oppdatert?"
Title = "Rådata"
response = MsgBox(ttekst, 65, Title)
If response = 2 Then End

ActiveSheet.Range("D13").Select
fil = Trim(ActiveCell.Value)
If fil = "" Then
 ptekst = "Mangler informasjon om katalog for rådata."
 Title = "Rådata"
 response = MsgBox(ptekst, 48, Title)
 End
End If

ActiveSheet.Range("D14").Select
filnavn = Trim(ActiveCell.Value)
If filnavn = "" Then
 ftekst = "Mangler informasjon om navn på rådatafilen."
 Title = "Rådata"
 response = MsgBox(ftekst, 48, Title)
 End
End If

ActiveSheet.Range("D15").Select
side = Trim(ActiveCell.Value)
If side = "" Then
 stekst = "Mangler informasjon om navn på side-tab i rådatafilen."
 Title = "Side-tab"
 response = MsgBox(stekst, 48, Title)
 End
End If

Windows("Tidspunkter - plakat Kino1.xls").Activate
Sheets("Format").Select
ActiveSheet.Range("A1:M500").Select
Selection.ClearContents
j = 1
nyfilm = 1
Sheets("Forside").Select

Workbooks.Open Filename:=fil + "\" + filnavn
Sheets(side).Select

ActiveSheet.Range("A1:K600").Select
Selection.Sort Key1:=ActiveSheet.Range("G1"), Order1:=xlAscending, Key2:=ActiveSheet.Range("B1") _
   , Order2:=xlAscending, Key3:=ActiveSheet.Range("C1"), Order3:=xlAscending, Header:= _
   xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom ', _
'   DataOption1:=xlSortTextAsNumbers, DataOption2:=xlSortTextAsNumbers, _
'   DataOption3:=xlSortTextAsNumbers
ActiveSheet.Range("A1").Select

For i = 1 To 1000
 celle = "A" + Trim(Str$(i))
 ActiveSheet.Range(celle).Select
 If ActiveCell.Value = "" Then
  antall = i - 1
  If antall = 0 Then
atekst = "Rådatafilen er tom."
Title = "Rådata"
response = MsgBox(atekst, 48, Title)
End
  End If
  i = 1000
 End If
Next i

gmltittel = ""

For i = 1 To antall

 celle = "B" + Trim(Str$(i))
 ActiveSheet.Range(celle).Select
 dato = Trim(ActiveCell.Value)
 d1 = Left(dato, 2)
 d2 = Mid(dato, 4, 2)
 d3 = Right(dato, 4)
 dato = d1 + "/" + d2
 ddato = d1 + "." + d2 + "." + d3
 dag = Weekday(ddato, vbMonday)
 dag = WeekdayName(dag, False, vbMonday)
 dag1 = UCase(Left(dag, 1))
 dag2 = Trim(Mid(dag, 2, 8))
 dag = Trim(dag1) + Trim(dag2)

 celle = "C" + Trim(Str$(i))
 ActiveSheet.Range(celle).Select
 klokke = ActiveCell.Value

'   If i = 10 Then Stop

 celle = "E" + Trim(Str$(i))
 ActiveSheet.Range(celle).Select
 alder = Trim(Str$(ActiveCell.Value))
 If alder = "0" Then alder = "Alle"

 celle = "G" + Trim(Str$(i))
 ActiveSheet.Range(celle).Select
 tittel = ActiveCell.Value

 Windows("Tidspunkter - plakat Kino1.xls").Activate
 Sheets("Format").Select
 ActiveSheet.Rows("2:500").Select
 Selection.RowHeight = 40.25
 Selection.Font.Size = 30

 If tittel <> gmltittel Then
  ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
  ActiveSheet.Range("A1:M500").Select
  Selection.ClearContents
  ActiveSheet.Range("A1").Select
  j = 1
  nyfilm = 1
 End If

 ActiveSheet.Range("A1").Select
 ActiveCell.Value = tittel

 If gmldato <> dato Or gmlklokke <> klokke Then
  If gmldato <> dato Then
Select Case nyfilm
Case 0
 j = j + 2
Case 1
 j = j + 1
 nyfilm = 0
Case Else
End Select
k = 2
  End If
  If gmldato = dato And gmlklokke <> klokke Then k = k + 1

  celle = "A" + Trim(Str$(j))
  ActiveSheet.Range(celle).Select
  ActiveCell.Value = ""

  celle = "A" + Trim(Str$(j))
  ActiveSheet.Range(celle).Select
  ActiveCell.Value = dag

  kol$ = Chr(64 + k)
  celle = Trim(kol$) + Trim(Str$(j))
  ActiveSheet.Range(celle).Select
  ActiveCell.Value = klokke

  celle = "A" + Trim(Str$(j + 2))
  ActiveSheet.Range(celle).Select
  ActiveCell.Value = "Aldersgrense: " + alder + " år"
  If alder = "Alle" Then ActiveCell.Value = "Aldersgrense: Alle"
 End If

 Windows(filnavn).Activate
 Sheets(side).Select

 gmlklokke = klokke
 gmldato = dato
 gmltittel = tittel

Next i

Windows(filnavn).Activate
ActiveWorkbook.Close SaveChanges:=False

Windows("Tidspunkter - plakat Kino1.xls").Activate
Sheets("Format").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
ActiveSheet.Range("A1").Select
Sheets("Forside").Select
ActiveSheet.Range("A1").Select

End Sub

 

Skal ha tittelen på arket som printes ut til å komme fra kolonnen I istedenfor G.

Noen som ser feilen kjapt??

[Manfred]

Du synes ikke dette så ut til å være relevante linjer?

 

  celle = "G" + Trim(Str$(i))
 ActiveSheet.Range(celle).Select
 tittel = ActiveCell.Value

 

Tenk litt sjæl, a. Jeg søkte etter "tittel" og finner det i samme kodeblokk som det står celle = "G"....

[tsunammi2k]

Ja jeg prøvde å skifte det til I, men da ble hele skriptet ødelagt og alt som kom ut var feil.. Har nok prøvd det ser du..