Hvordan tilberede et drikkehorn

Når du får hornet ditt og du evt. har skrapt vekk det verste på innsiden så bør du fylle hornet med vann og litt klor og la det stå over natta. Dette vil fjerne endel av lukta og desinfisere. Skyll veldig godt med vann etterpå! Om du skal bruke honningvoks på innsiden (dette får man som regel kjøpt i biter, om du vil bruke honninglys så vær oppmerksom på at voksen ha blitt blandet med andre typer voks...) så er det lurt å varme voksen i en liten kasserolle som står i en stor kasserolle fyllt med vann, voksen skal ikke koke. Det hjelper om du varmer opp hornet på forhånd under springen slik at ikke voksen stivner med en gang når du skal dekke innsiden. Hell voks i hornet og roter hornet slik at sidene blir dekket (gjør dette et par ganger slik at du ser at alt er dekket), hell voksen som blir til overs tilbake i kjelen som står i vannbad. Om du har brukt lakk på innsiden så bør du fylle hornet med brennevin og la det stå over natta. Dette er for å ta livet av evt. bakterier og for å sørge for at lakken stivner skikkelig. Hell ut brennevinet dagen etterpå og skyll godt!! Om du har brukt honningvoks så trenger du ikke dette. Fordelen med lakk er at du kan drikke varme drikker og sterk alkohol fra drikkehornet ditt.

Tøgers fabel: «Jenta som ropte alv»

DET VAR ENGANG ei jente som passet ungene for folk i landsbyen. Hver
morgen samlet hun sammen ungene og drev dem ut på lek, hver kveld samlet hun dem igjen, og drev dem tilbake sine folk.
Noen dager kunne det være fint der oppe i fjellskråningen, og tiden gikk fort, men andre dager kjedet hun seg, og tiden falt lang, fordi hun ikke hadde annet å gjøre enn å se på ungene som gikk der og lekte fra morgen til kveld.... Vis mer
En dag fant hun på noe å more seg med: «Alven kommer! Alven kommer! » ropte hun av full hals. «Det er en alv som vil ta ungene! »
Folk i landsbyen slapp alt de hadde i hendene og kom løpende alt de orket for å jage bort alven. Men så var det jo ingen alv; de fant bare jenta som lo så tårene
trillet da hun fikk se de sinte, røde fjesene.
Jenta prøvde det samme påfunnet både èn gang til og flere ganger, og hver gang kom folkene opp fra landsbyen for å hjelpe henne mot alven. Men så, sent en vinterkveld, nettopp som jenta skulle til å samle ungene for hjemturen, kom alven virkelig. Hun merket det først på ungene, som med ett ble så urolige og gav seg til å syte. Og like etter kunne hun skimte en lang, grå skygge som nærmet seg gruppen gjennom halvmørket. Nå var jenta ordentlig redd, for alven så stor og farlig ut, og hun hadde bare staven sin å slåss med.
Hun begynte å rope sa høyt hun kunne: «Alven kommer! Alven kommer! Det er en alv som vil ta ungene!» Men denne gang kom det ingen folk løpende fra landsbyen for å hjelpe henne.
En og annen så opp da de hørte ropene, men de fleste ristet bare på hodet og sa til hverandre:
“Nei, den går ikke lenger! Hun har narret oss med det der en gang for mye!”
Før jenta klarte å hente hjelp, hadde alven tatt hele ungeflokken.
Ingen vil tro en løgnhals - selv når hun taler sant.

Korsvika Dugnad 8. mai

Mine VBA

Sub LangInFrames()
'MsgBox "Give me the language ID" & Application.LanguageSettings.LanguageID(msoLanguageIDUI)
scount = ActivePresentation.Slides.Count
For j = 1 To scount
fcount = ActivePresentation.Slides(j).Shapes.Count
For k = 1 To fcount
If ActivePresentation.Slides(j).Shapes(k).HasTextFrame Then
ActivePresentation.Slides(j).Shapes(k).TextFrame.TextRange _
.LanguageID = &H414 ' 1044 ' msoLanguageIDNorwegian
End If
Next k
Next j
End Sub


'http://support.microsoft.com/kb/221435







Private Sub Worksheet_Activate()


'Hardware I-O
IOtotal = 0
IOSignTotal = 0
IOrad = 6

LEDIG = 0

Do Until Worksheets("I-O").Cells(IOrad, 2).Value = "Slutt" 'rad, kolumnscore


' Finner antall ledige som vi ikke ønsker skal påvirke prosentutrekningen

If Worksheets("I-O").Cells(IOrad, 11).Value = "LEDIG" Then
LEDIG = LEDIG + 1
End If

If Worksheets("I-O").Cells(IOrad, 2).Value <> Empty Then
IOtotal = IOtotal + 1
End If
If Worksheets("I-O").Cells(IOrad, 11).Value <> Empty Then
IOSignTotal = IOSignTotal + 1
End If

IOrad = IOrad + 1
Loop

IOUtfallprosent = (Abs(IOSignTotal - LEDIG) / Abs(IOtotal - LEDIG)) * 100

'Presentera data for I-O testen

'[Rad, Kolonne]

Worksheets("Scorecard").Cells(4, 3).Value = Round(IOUtfallprosent)



'Motorvern-Effektbrytere-HS_vern
Enhetertotalt = 0
SignTotal = 0
rad = 4

Do Until Worksheets("Motorvern-Effektbrytere-HS_vern").Cells(rad, 11).Value = "Slutt" 'rad, kolumnscore

If Worksheets("Motorvern-Effektbrytere-HS_vern").Cells(rad, 11).Value = "x" Then
Enhetertotalt = Enhetertotalt + 1

End If
If Worksheets("Motorvern-Effektbrytere-HS_vern").Cells(rad, 9).Value <> Empty Then
SignTotal = SignTotal + 1

End If

rad = rad + 1
Loop

Utfallprosent = (CLng(SignTotal) / Enhetertotalt) * 100

'Presentera data for Motorvern-Effektbrytere-HS_vern testen

'[Rad, Kolonne]

Worksheets("Scorecard").Cells(4, 4).Value = Round(Utfallprosent)

End Sub



Private Sub CommandButton1_Click()
'
' Historik Makro
'

' Oppdatere historien

'Spørr etter ønsket ukenummer
Msg = "Skriv inn aktuelle uke (Format: ÅUU)" ' Define message.
'Style = vbYesNo ' Define buttons.
Title = "Velg uke" ' Define title
ValgtUke = InputBox(Msg, Title)
If ValgtUke = "" Then ' Cancel
End ' Avsluta makro
End If


'Kontrollerer om data er lagret siden sist

Ukepeker = 3

For Kolumn = 3 To 54 '36
If Worksheets("Scorecard_Historie").Cells(5, Kolumn).Text = ValgtUke Then
aktuellkolumn = Kolumn
End If


Next Kolumn

If aktuellkolumn < 3 Then
Msg = "Feilaktig ukenummer. (901-952) er gyldig " ' Define message. OLD 745-826
Style = vbOKOnly ' Define buttons.
Title = "FEIL" ' Define title
Response = MsgBox(Msg, Style, Title)
End ' Avslutt makro
End If


If Worksheets("Scorecard_Historie").Cells(1, aktuellkolumn).Value > 0 Then
Msg = "Historikken er allerede lagret for angitte uke. Ønsker du å oppdatere?" ' Define message.
Style = vbYesNo ' Define buttons.
Title = "Oppdatering" ' Define title
Response = MsgBox(Msg, Style, Title)

If Response = 7 Then ' No
End ' Avsluta makro
End If
End If

'Oppdatere Utfall
Worksheets("Scorecard_Historie").Cells(6, aktuellkolumn).Value = Worksheets("Scorecard").Cells(4, 3).Value
Worksheets("Scorecard_Historie").Cells(11, aktuellkolumn).Value = Worksheets("Scorecard").Cells(4, 4).Value

'Informere om at data har blitt oppdatert
Worksheets("Scorecard_Historie").Cells(1, aktuellkolumn).Value = ValgtUke

Msg = "Data er oppdatert !" ' Define message.
Style = vbOKOnly ' Define buttons.
Title = "Ferdig" ' Define title
Response = MsgBox(Msg, Style, Title)




End Sub



Private Sub Worksheet_Activate()


'Hardware I-O
IOtotal = 0
IOSignTotal = 0
IOrad = 6

LEDIG = 0

Do Until Worksheets("I-O").Cells(IOrad, 2).Value = "Slutt" 'rad, kolumnscore


' Finner antall ledige som vi ikke ønsker skal påvirke prosentutrekningen

If Worksheets("I-O").Cells(IOrad, 11).Value = "LEDIG" Then
LEDIG = LEDIG + 1
End If

If Worksheets("I-O").Cells(IOrad, 2).Value <> Empty Then
IOtotal = IOtotal + 1
End If
If Worksheets("I-O").Cells(IOrad, 11).Value <> Empty Then
IOSignTotal = IOSignTotal + 1
End If

IOrad = IOrad + 1
Loop

IOUtfallprosent = (Abs(IOSignTotal - LEDIG) / Abs(IOtotal - LEDIG)) * 100

'Presentera data for I-O testen

'[Rad, Kolonne]

Worksheets("Scorecard").Cells(4, 3).Value = Round(IOUtfallprosent)



'Motorvern-Effektbrytere-HS_vern
Enhetertotalt = 0
SignTotal = 0
rad = 4

Do Until Worksheets("Motorvern-Effektbrytere-HS_vern").Cells(rad, 11).Value = "Slutt" 'rad, kolumnscore

If Worksheets("Motorvern-Effektbrytere-HS_vern").Cells(rad, 11).Value = "x" Then
Enhetertotalt = Enhetertotalt + 1

End If
If Worksheets("Motorvern-Effektbrytere-HS_vern").Cells(rad, 9).Value <> Empty Then
SignTotal = SignTotal + 1

End If

rad = rad + 1
Loop

Utfallprosent = (CLng(SignTotal) / Enhetertotalt) * 100

'Presentera data for Motorvern-Effektbrytere-HS_vern testen

'[Rad, Kolonne]

Worksheets("Scorecard").Cells(4, 4).Value = Round(Utfallprosent)

End Sub



Private Sub CommandButton1_Click()
'
' Historik Makro
'

' Oppdatere historien

'Spørr etter ønsket ukenummer
Msg = "Skriv inn aktuelle uke (Format: ÅUU)" ' Define message.
'Style = vbYesNo ' Define buttons.
Title = "Velg uke" ' Define title
ValgtUke = InputBox(Msg, Title)
If ValgtUke = "" Then ' Cancel
End ' Avsluta makro
End If


'Kontrollerer om data er lagret siden sist

Ukepeker = 3

For Kolumn = 3 To 54 '36
If Worksheets("Scorecard_Historie").Cells(5, Kolumn).Text = ValgtUke Then
aktuellkolumn = Kolumn
End If


Next Kolumn

If aktuellkolumn < 3 Then
Msg = "Feilaktig ukenummer. (901-952) er gyldig " ' Define message. OLD 745-826
Style = vbOKOnly ' Define buttons.
Title = "FEIL" ' Define title
Response = MsgBox(Msg, Style, Title)
End ' Avslutt makro
End If


If Worksheets("Scorecard_Historie").Cells(1, aktuellkolumn).Value > 0 Then
Msg = "Historikken er allerede lagret for angitte uke. Ønsker du å oppdatere?" ' Define message.
Style = vbYesNo ' Define buttons.
Title = "Oppdatering" ' Define title
Response = MsgBox(Msg, Style, Title)

If Response = 7 Then ' No
End ' Avsluta makro
End If
End If

'Oppdatere Utfall
Worksheets("Scorecard_Historie").Cells(6, aktuellkolumn).Value = Worksheets("Scorecard").Cells(4, 3).Value
Worksheets("Scorecard_Historie").Cells(11, aktuellkolumn).Value = Worksheets("Scorecard").Cells(4, 4).Value

'Informere om at data har blitt oppdatert
Worksheets("Scorecard_Historie").Cells(1, aktuellkolumn).Value = ValgtUke

Msg = "Data er oppdatert !" ' Define message.
Style = vbOKOnly ' Define buttons.
Title = "Ferdig" ' Define title
Response = MsgBox(Msg, Style, Title)




End Sub








'------------------------------------------------------------------------'


'Declare Public variables
Public ScriptBook, FileBook, DWGFile, DWGSheet, AutoPrintBook, DWGDirectory


Sub Auto_Open()
Set AutoPrintBook = ActiveWorkbook
'Start the Macro
' If Splash_Screen = True Then
'If the user accepts the license conditions, run module
AutoCAD_AutoPrint
' Else
' Workbooks(AutoPrintBook.Name).Close (False)
' End If

End Sub


Sub AutoCAD_AutoPrint()
'Declare Private variables
Dim rvalue

'Get the User's Choice
rvalue = User_Choice

'Loop until the user selects the Quit Button
Do While rvalue <> False
'Based on the user's choice, Open the DWG File Workbook and
'create a workbook for the script file
Select Case rvalue
Case 1
'User chose to print all .DWG files in a directory,
'get the directory information
rvalue = Print_Directory
Case 2
'User chose to open a text file that contains the .dwg file names
rvalue = Open_Text
Case 3
'User chose to open an excel file with the .dwg file names
rvalue = Open_Excel
Case Else
'Break the Do-Loop
Exit Do
End Select

'If the User gave a valid directory/text file/excel file
'then build the auto print script
If rvalue = True Then
Build_Script
End If

'See if user wants to build another script
rvalue = User_Choice
Loop

'Close the Book

Workbooks(AutoPrintBook.Name).Close

End Sub


Function Splash_Screen()
'This function will return the following:
' True if the User agrees to the licensing conditions.
' False if the user presses the quit button.
'
Splash_Screen = Workbooks(AutoPrintBook.Name).DialogSheets("dsSplashScreen").Show
End Function

Function User_Choice()
'This function will return the following:
' False if the user chose to quit the program
' 1. if the user chose to Print all .dwg files in a directory
' 2. if the user chose to open a text file
' 3. if the user chose to open an excel file
'
'Display the dialog sheet showing the user's choices
If DialogSheets("dsChoice").Show = True Then

'Determine which option was chosen
If DialogSheets("dsChoice").OptionButtons("DWGDirectory") = xlOn Then
User_Choice = 1
ElseIf DialogSheets("dsChoice").OptionButtons("DWGText") = xlOn Then
User_Choice = 2
ElseIf DialogSheets("dsChoice").OptionButtons("DWGExcel") = xlOn Then
User_Choice = 3
Else
'If no option was chosen
User_Choice = False
End If
Else
User_Choice = False
End If

End Function


Function Print_Directory()
'This function will return the following:
' TRUE if the user entered a valid directory
' FALSE if the user chose the Cancel Button

'Declare Private Variables
Dim FileName ', DWGDirectory
Dim ACADVersion

'Display dialog sheet for Directory Path
If DialogSheets("dsDirectory").Show = True Then

'Confirm that the directory exists
While Dir( _
DialogSheets("dsDirectory").EditBoxes("DirectoryPath").Text, _
vbDirectory) = ""
MsgBox prompt:="Invalid Directory Path Entered", _
Buttons:=vbExclaimation
If DialogSheets("dsDirectory").Show = False Then
Print_Directory = False
Exit Function
End If
Wend

'Build the directory path
DWGDirectory = DialogSheets("dsDirectory").EditBoxes("DirectoryPath").Text

' MsgBox (DWGDirectory)


If Right(DWGDirectory, 1) <> "\" Then
DWGDirectory = DWGDirectory & "\"
End If

'Add the working WorkBook
Workbooks.Add
Set ScriptBook = ActiveWorkbook
Set FileBook = ActiveWorkbook

Sheets.Add 'Da virker denne koden.

Sheets("Sheet2").Name = "Print Script"
' DWGSheet = 2

DWGSheet = 1

Sheets(DWGSheet).Select


Range("a1").Activate
Set DWGFile = ActiveCell

'Read in Files until done
FileName = Dir(DWGDirectory & "*.dwg")



While FileName <> ""
ActiveCell.Formula = DWGDirectory & FileName
ActiveCell.Offset(1, 0).Activate 'skifter linje i excelarket
FileName = Dir()



Wend
Print_Directory = True
Else
Print_Directory = False
End If

End Function


Function Open_Text()
'This function will return the following:
' TRUE if the user gave a valid text file to be opened
' FALSE if the user pressed the Cancel Button

'Declare Private variables
Dim TextFile

'Get the file to open
TextFile = Application.GetOpenFilename
'If user pressed Cancel
If TextFile = False Then
Open_Text = False
Exit Function
End If

'Open the text file
Workbooks.OpenText FileName:=TextFile, Origin:=xlWindows, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon _
:=False, Comma:=True, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), _
Array(6, 1), Array(7, 1), Array(8, 1))

Set FileBook = ActiveWorkbook
DWGSheet = 1
Sheets(DWGSheet).Select

Range("a1").Activate
Set DWGFile = ActiveCell

'Add a workbook for for the script file
Workbooks.Add
Set ScriptBook = ActiveWorkbook
Sheets("Sheet1").Name = "Print Script"

Open_Text = True

End Function

Function Open_Excel()
'This function will return the following:
' TRUE if the user entered a valid excel file name
' FALSE if the user pressed the Cancel button

'Declare Private variables
Dim ExcelName, SheetNumber

'Get the file name
ExcelName = Application.GetOpenFilename

If ExcelName = False Then
Open_Excel = False
Exit Function
End If

'Open the workbook
Workbooks.Open FileName:=ExcelName

'ask the user for the sheet number to use
DWGSheet = InputBox("Enter the WorkSheet number to use:", _
"Select WorkSheet Number", "1")
DWGSheet = CInt(DWGSheet)
Set FileBook = ActiveWorkbook
DWGSheet = 1
Sheets(DWGSheet).Select

Range("a1").Activate
Set DWGFile = ActiveCell 'ønsket dwgfile blir satt

Workbooks.Add
Set ScriptBook = ActiveWorkbook
Sheets("Sheet1").Name = "Print Script"

Open_Excel = True

End Function



'
' Visual Basic Macro to create a script file for printing.
'
Sub Build_Script()

'Declare Private variables
Dim savefile, count, ACADVersion, Printer

' Application.ScreenUpdating = False ' Turn off the screen update

'Check the Version of AutoCAD
Workbooks(AutoPrintBook.Name).Activate 'aktiverer arket som inneholder macro

'MsgBox (AutoPrintBook.Name)= acadprt.xls

'Determine AutoCAD Version
If DialogSheets("dsChoice").OptionButtons("Ver14") = xlOn Then
ACADVersion = "14"
ElseIf DialogSheets("dsChoice").OptionButtons("LT2000") = xlOn Then
ACADVersion = "2000"
Else
ACADVersion = "12"
End If

'MsgBox (ScriptBook.Name) = book1.xls

'Goto the Script Book

Windows(ScriptBook.Name).Activate ' aktivere arbeidsboka

Sheets("Print Script").Select
Range("a1").Activate 'velger celle a1

If ACADVersion = "12" Or ACADVersion = "14" Then
ActiveCell.Formula = "._quit _y"
Else
'ActiveCell.Formula = "._close" ' overskriver celle a1 med ._close

End If

count = 1 'Count får verdien 1

' Legg inn mulighet for å skrive inn ønsket printer
Printer = InputBox("Skirv inn ønsket printer:", "Printervalg", "\\NOTRDB1002SRV\TRDS021P-PCL")

'Build script while there are file names in DWGFile
While DWGFile <> ""


If count > 1 Then
If ACADVersion = "12" Or ACADVersion = "14" Then
ActiveCell.Formula = "._quit _y"
Else

Sheets("sheet1").Activate

ActiveCell.Formula = "._close _y"
End If
End If



ActiveCell.Offset(1, 0).Activate 'velger celle a(1+1)
If ACADVersion = "12" Or ACADVersion = "14" Then
ActiveCell.Formula = "2"
Else

Sheets("sheet1").Activate

ActiveCell.Formula = "._open" 'overskriver celle a(1+1) med ._open
End If
ActiveCell.Offset(1, 0).Activate 'ny linje
ActiveCell.Formula = DWGFile

ActiveCell.Offset(1, 0).Activate
ActiveCell.Formula = "-plot"

ActiveCell.Offset(1, 0).Activate
ActiveCell.Formula = "Y"
ActiveCell.Offset(1, 0).Activate
ActiveCell.Formula = "MODEL"
ActiveCell.Offset(1, 0).Activate
'ActiveCell.Formula = "\\NOTRDB1002SRV\TRDS021P-PCL"


ActiveCell.Formula = Printer

ActiveCell.Offset(1, 0).Activate
ActiveCell.Formula = "A4"
ActiveCell.Offset(1, 0).Activate
ActiveCell.Formula = "m"
ActiveCell.Offset(1, 0).Activate
ActiveCell.Formula = "L"
ActiveCell.Offset(1, 0).Activate
ActiveCell.Formula = "NO"
ActiveCell.Offset(1, 0).Activate
ActiveCell.Formula = "Limits"
ActiveCell.Offset(1, 0).Activate
ActiveCell.Formula = "FIT"
ActiveCell.Offset(1, 0).Activate


ActiveCell = "'" & Format(123, "00000000") 'formatere cellen til tekstformat


ActiveCell.Formula = "0,0"


ActiveCell.Offset(1, 0).Activate
ActiveCell.Formula = "NO"
ActiveCell.Offset(1, 0).Activate
ActiveCell.Formula = "Siemens.ctb"
ActiveCell.Offset(1, 0).Activate
ActiveCell.Formula = "YES"
ActiveCell.Offset(1, 0).Activate
ActiveCell.Formula = "YES"
ActiveCell.Offset(1, 0).Activate
ActiveCell.Formula = "N"
ActiveCell.Offset(1, 0).Activate
ActiveCell.Formula = "Y"
ActiveCell.Offset(1, 0).Activate
ActiveCell.Formula = "Y"



Workbooks(ScriptBook.Name).Activate 'aktiverer arbeidsboka bookX.xls igjen?!?!



If ACADVersion = "14" Then
ActiveCell.Offset(3, 0).Activate
ElseIf ACADVersion = "12" Then
ActiveCell.Offset(4, 0).Activate
Else

ActiveCell.Offset(1, 0).Activate
End If

'Get the next file name
Windows(FileBook.Name).Activate

Sheets(DWGSheet).Select ' dvs Print Script

Range(DWGFile.Address).Activate 'aktiverer A1

ActiveCell.Offset(1, 0).Activate
Set DWGFile = ActiveCell 'oppdaterer DWGFile

Workbooks(ScriptBook.Name).Activate
Sheets("Print Script").Select
Application.StatusBar = "Processing Record: " & count
count = count + 1 'count oppdateres med +1
Wend

If ACADVersion = "12" Or ACADVersion = "14" Then
ActiveCell.Formula = "._quit _y"
Else

Sheets("sheet1").Activate

ActiveCell.Formula = "._close _n"
End If

Application.StatusBar = False
Application.ScreenUpdating = True ' Turn on screen update

'Display the Complete Dialog sheet

Windows(AutoPrintBook.Name).Activate

DialogSheets("dsComplete").Show

'Save out the script file
Workbooks(ScriptBook.Name).Activate
' Sheets("Print Script").Select


' savefile = Application.GetSaveAsFilename("AutoPrnt.scr")
' If savefile <> "" Then
' ActiveWorkbook.SaveAs FileName:=savefile, FileFormat:=xlText, _
' CreateBackup:=False
' End If

Sheets("sheet1").Select

'FileName = Dir(DWGDirectory & "*.dwg")
Open DWGDirectory & "AutoPrt.scr" For Output As 1
' Open "c:\CAD-Print\AutoPrt.scr" For Output As 1
ce = Range("A1")

Range("a1").Select
While ce <> ""
Print #1, ce
ActiveCell.Offset(1, 0).Activate
ce = ActiveCell.Formula
Wend
Close #1



If (FileBook.Name = ScriptBook.Name) Then
ActiveWorkbook.Close (False)
Else
Workbooks(ScriptBook.Name).Activate
ActiveWorkbook.Close (False)
Workbooks(FileBook.Name).Activate
ActiveWorkbook.Close (False)
End If

End Sub'------------------------------------------------------------------------'


'Declare Public variables
Public ScriptBook, FileBook, DWGFile, DWGSheet, AutoPrintBook, DWGDirectory


Sub Auto_Open()
Set AutoPrintBook = ActiveWorkbook
'Start the Macro
' If Splash_Screen = True Then
'If the user accepts the license conditions, run module
AutoCAD_AutoPrint
' Else
' Workbooks(AutoPrintBook.Name).Close (False)
' End If

End Sub


Sub AutoCAD_AutoPrint()
'Declare Private variables
Dim rvalue

'Get the User's Choice
rvalue = User_Choice

'Loop until the user selects the Quit Button
Do While rvalue <> False
'Based on the user's choice, Open the DWG File Workbook and
'create a workbook for the script file
Select Case rvalue
Case 1
'User chose to print all .DWG files in a directory,
'get the directory information
rvalue = Print_Directory
Case 2
'User chose to open a text file that contains the .dwg file names
rvalue = Open_Text
Case 3
'User chose to open an excel file with the .dwg file names
rvalue = Open_Excel
Case Else
'Break the Do-Loop
Exit Do
End Select

'If the User gave a valid directory/text file/excel file
'then build the auto print script
If rvalue = True Then
Build_Script
End If

'See if user wants to build another script
rvalue = User_Choice
Loop

'Close the Book

Workbooks(AutoPrintBook.Name).Close

End Sub


Function Splash_Screen()
'This function will return the following:
' True if the User agrees to the licensing conditions.
' False if the user presses the quit button.
'
Splash_Screen = Workbooks(AutoPrintBook.Name).DialogSheets("dsSplashScreen").Show
End Function

Function User_Choice()
'This function will return the following:
' False if the user chose to quit the program
' 1. if the user chose to Print all .dwg files in a directory
' 2. if the user chose to open a text file
' 3. if the user chose to open an excel file
'
'Display the dialog sheet showing the user's choices
If DialogSheets("dsChoice").Show = True Then

'Determine which option was chosen
If DialogSheets("dsChoice").OptionButtons("DWGDirectory") = xlOn Then
User_Choice = 1
ElseIf DialogSheets("dsChoice").OptionButtons("DWGText") = xlOn Then
User_Choice = 2
ElseIf DialogSheets("dsChoice").OptionButtons("DWGExcel") = xlOn Then
User_Choice = 3
Else
'If no option was chosen
User_Choice = False
End If
Else
User_Choice = False
End If

End Function


Function Print_Directory()
'This function will return the following:
' TRUE if the user entered a valid directory
' FALSE if the user chose the Cancel Button

'Declare Private Variables
Dim FileName ', DWGDirectory
Dim ACADVersion

'Display dialog sheet for Directory Path
If DialogSheets("dsDirectory").Show = True Then

'Confirm that the directory exists
While Dir( _
DialogSheets("dsDirectory").EditBoxes("DirectoryPath").Text, _
vbDirectory) = ""
MsgBox prompt:="Invalid Directory Path Entered", _
Buttons:=vbExclaimation
If DialogSheets("dsDirectory").Show = False Then
Print_Directory = False
Exit Function
End If
Wend

'Build the directory path
DWGDirectory = DialogSheets("dsDirectory").EditBoxes("DirectoryPath").Text

' MsgBox (DWGDirectory)


If Right(DWGDirectory, 1) <> "\" Then
DWGDirectory = DWGDirectory & "\"
End If

'Add the working WorkBook
Workbooks.Add
Set ScriptBook = ActiveWorkbook
Set FileBook = ActiveWorkbook

Sheets.Add 'Da virker denne koden.

Sheets("Sheet2").Name = "Print Script"
' DWGSheet = 2

DWGSheet = 1

Sheets(DWGSheet).Select


Range("a1").Activate
Set DWGFile = ActiveCell

'Read in Files until done
FileName = Dir(DWGDirectory & "*.dwg")



While FileName <> ""
ActiveCell.Formula = DWGDirectory & FileName
ActiveCell.Offset(1, 0).Activate 'skifter linje i excelarket
FileName = Dir()



Wend
Print_Directory = True
Else
Print_Directory = False
End If

End Function


Function Open_Text()
'This function will return the following:
' TRUE if the user gave a valid text file to be opened
' FALSE if the user pressed the Cancel Button

'Declare Private variables
Dim TextFile

'Get the file to open
TextFile = Application.GetOpenFilename
'If user pressed Cancel
If TextFile = False Then
Open_Text = False
Exit Function
End If

'Open the text file
Workbooks.OpenText FileName:=TextFile, Origin:=xlWindows, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon _
:=False, Comma:=True, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), _
Array(6, 1), Array(7, 1), Array(8, 1))

Set FileBook = ActiveWorkbook
DWGSheet = 1
Sheets(DWGSheet).Select

Range("a1").Activate
Set DWGFile = ActiveCell

'Add a workbook for for the script file
Workbooks.Add
Set ScriptBook = ActiveWorkbook
Sheets("Sheet1").Name = "Print Script"

Open_Text = True

End Function

Function Open_Excel()
'This function will return the following:
' TRUE if the user entered a valid excel file name
' FALSE if the user pressed the Cancel button

'Declare Private variables
Dim ExcelName, SheetNumber

'Get the file name
ExcelName = Application.GetOpenFilename

If ExcelName = False Then
Open_Excel = False
Exit Function
End If

'Open the workbook
Workbooks.Open FileName:=ExcelName

'ask the user for the sheet number to use
DWGSheet = InputBox("Enter the WorkSheet number to use:", _
"Select WorkSheet Number", "1")
DWGSheet = CInt(DWGSheet)
Set FileBook = ActiveWorkbook
DWGSheet = 1
Sheets(DWGSheet).Select

Range("a1").Activate
Set DWGFile = ActiveCell 'ønsket dwgfile blir satt

Workbooks.Add
Set ScriptBook = ActiveWorkbook
Sheets("Sheet1").Name = "Print Script"

Open_Excel = True

End Function



'
' Visual Basic Macro to create a script file for printing.
'
Sub Build_Script()

'Declare Private variables
Dim savefile, count, ACADVersion, Printer

' Application.ScreenUpdating = False ' Turn off the screen update

'Check the Version of AutoCAD
Workbooks(AutoPrintBook.Name).Activate 'aktiverer arket som inneholder macro

'MsgBox (AutoPrintBook.Name)= acadprt.xls

'Determine AutoCAD Version
If DialogSheets("dsChoice").OptionButtons("Ver14") = xlOn Then
ACADVersion = "14"
ElseIf DialogSheets("dsChoice").OptionButtons("LT2000") = xlOn Then
ACADVersion = "2000"
Else
ACADVersion = "12"
End If

'MsgBox (ScriptBook.Name) = book1.xls

'Goto the Script Book

Windows(ScriptBook.Name).Activate ' aktivere arbeidsboka

Sheets("Print Script").Select
Range("a1").Activate 'velger celle a1

If ACADVersion = "12" Or ACADVersion = "14" Then
ActiveCell.Formula = "._quit _y"
Else
'ActiveCell.Formula = "._close" ' overskriver celle a1 med ._close

End If

count = 1 'Count får verdien 1

' Legg inn mulighet for å skrive inn ønsket printer
Printer = InputBox("Skirv inn ønsket printer:", "Printervalg", "\\NOTRDB1002SRV\TRDS021P-PCL")

'Build script while there are file names in DWGFile
While DWGFile <> ""


If count > 1 Then
If ACADVersion = "12" Or ACADVersion = "14" Then
ActiveCell.Formula = "._quit _y"
Else

Sheets("sheet1").Activate

ActiveCell.Formula = "._close _y"
End If
End If



ActiveCell.Offset(1, 0).Activate 'velger celle a(1+1)
If ACADVersion = "12" Or ACADVersion = "14" Then
ActiveCell.Formula = "2"
Else

Sheets("sheet1").Activate

ActiveCell.Formula = "._open" 'overskriver celle a(1+1) med ._open
End If
ActiveCell.Offset(1, 0).Activate 'ny linje
ActiveCell.Formula = DWGFile

ActiveCell.Offset(1, 0).Activate
ActiveCell.Formula = "-plot"

ActiveCell.Offset(1, 0).Activate
ActiveCell.Formula = "Y"
ActiveCell.Offset(1, 0).Activate
ActiveCell.Formula = "MODEL"
ActiveCell.Offset(1, 0).Activate
'ActiveCell.Formula = "\\NOTRDB1002SRV\TRDS021P-PCL"


ActiveCell.Formula = Printer

ActiveCell.Offset(1, 0).Activate
ActiveCell.Formula = "A4"
ActiveCell.Offset(1, 0).Activate
ActiveCell.Formula = "m"
ActiveCell.Offset(1, 0).Activate
ActiveCell.Formula = "L"
ActiveCell.Offset(1, 0).Activate
ActiveCell.Formula = "NO"
ActiveCell.Offset(1, 0).Activate
ActiveCell.Formula = "Limits"
ActiveCell.Offset(1, 0).Activate
ActiveCell.Formula = "FIT"
ActiveCell.Offset(1, 0).Activate


ActiveCell = "'" & Format(123, "00000000") 'formatere cellen til tekstformat


ActiveCell.Formula = "0,0"


ActiveCell.Offset(1, 0).Activate
ActiveCell.Formula = "NO"
ActiveCell.Offset(1, 0).Activate
ActiveCell.Formula = "Siemens.ctb"
ActiveCell.Offset(1, 0).Activate
ActiveCell.Formula = "YES"
ActiveCell.Offset(1, 0).Activate
ActiveCell.Formula = "YES"
ActiveCell.Offset(1, 0).Activate
ActiveCell.Formula = "N"
ActiveCell.Offset(1, 0).Activate
ActiveCell.Formula = "Y"
ActiveCell.Offset(1, 0).Activate
ActiveCell.Formula = "Y"



Workbooks(ScriptBook.Name).Activate 'aktiverer arbeidsboka bookX.xls igjen?!?!



If ACADVersion = "14" Then
ActiveCell.Offset(3, 0).Activate
ElseIf ACADVersion = "12" Then
ActiveCell.Offset(4, 0).Activate
Else

ActiveCell.Offset(1, 0).Activate
End If

'Get the next file name
Windows(FileBook.Name).Activate

Sheets(DWGSheet).Select ' dvs Print Script

Range(DWGFile.Address).Activate 'aktiverer A1

ActiveCell.Offset(1, 0).Activate
Set DWGFile = ActiveCell 'oppdaterer DWGFile

Workbooks(ScriptBook.Name).Activate
Sheets("Print Script").Select
Application.StatusBar = "Processing Record: " & count
count = count + 1 'count oppdateres med +1
Wend

If ACADVersion = "12" Or ACADVersion = "14" Then
ActiveCell.Formula = "._quit _y"
Else

Sheets("sheet1").Activate

ActiveCell.Formula = "._close _n"
End If

Application.StatusBar = False
Application.ScreenUpdating = True ' Turn on screen update

'Display the Complete Dialog sheet

Windows(AutoPrintBook.Name).Activate

DialogSheets("dsComplete").Show

'Save out the script file
Workbooks(ScriptBook.Name).Activate
' Sheets("Print Script").Select


' savefile = Application.GetSaveAsFilename("AutoPrnt.scr")
' If savefile <> "" Then
' ActiveWorkbook.SaveAs FileName:=savefile, FileFormat:=xlText, _
' CreateBackup:=False
' End If

Sheets("sheet1").Select

'FileName = Dir(DWGDirectory & "*.dwg")
Open DWGDirectory & "AutoPrt.scr" For Output As 1
' Open "c:\CAD-Print\AutoPrt.scr" For Output As 1
ce = Range("A1")

Range("a1").Select
While ce <> ""
Print #1, ce
ActiveCell.Offset(1, 0).Activate
ce = ActiveCell.Formula
Wend
Close #1



If (FileBook.Name = ScriptBook.Name) Then
ActiveWorkbook.Close (False)
Else
Workbooks(ScriptBook.Name).Activate
ActiveWorkbook.Close (False)
Workbooks(FileBook.Name).Activate
ActiveWorkbook.Close (False)
End If

End Sub

BARE EN SOMMERFLØRT

tenkte han

måtte sommeren vare evig
tenkte hun

sommeren på sin side
hatet å ta parti

så av hensyn til
sin egen samvittighet
brøt den idyllen og lunsjen
ved å slippe noen dråpter i hvitvinen
og lot det fortsette å regne til september

Tips om tursko

Noen smarte tips

• Vask skoene i lunket vann. Tørk av vann og skitt før du setter dem bort etter bruk.
• Oppbevar skoene i romtemperatur. Selv forholdsvis lave temperaturer som varme fra et gulv kan føre til at eventuelt skinn tørker over tid.
• Impregner og bruk skokrem gjerne hver dag under krevende forhold. Dette er også viktig på fottøy med membran.
• Ta av deg støvlene og ta ut innersålene ved enhver anledning når du er ute på tur. Dette kan redusere fuktigheten i skoene med hele 50 prosent.
• Går du med vanntette bukser, kan kraftig tape omgjøre buksene og skoene til vadere om du skulle trenge å forsere elver som er høyere enn støvelskaftet. Ikke snør igjen for stramt over vristen, da dette kan redusere blodomløpet i foten.
• Bruk eventuelle låsekroker slik at du kan stramme til bedre rundt ankelen om du trenger det for et godt hælgrep eller støtte i ankel.
• Bruk sokker i et fukttransporterende materiale, ikke bomullssokker.

Hun skyldte på våren

da hun med beruset blikk og
blussende kinn
kom for sent for tredje gang
den uken

men våren ville ha seg frabedt
slike beskyldniger
livredd som den var for å blir stuet bort
i et hjørne av parken
kun forbeholde de mest avhengige