Skabeloner skal virke i både Word 2000 og 2003
Jeg har lavet 2 skabeloner der virker i Word 2000, men så fandt jeg ud af, at de ikke helt fungerede i Word 2003. Mærkeligt nok er det bare ikke samme fejl, jeg får på forskellige maskiner.Jeg ved ikke om det er kode, eller om det er en indstilling der skal slås til, eller måske begge dele.
Men I får lige koden, jeg kan selvfølgelig ikke huske de forskellige fejl 100%, men kommer med dem i morgen.
Brevskabelon:
----------------------------------------------------------------
Public rs
Public afsName, afsTlf, afsMail, afsTitle, afsMobile, afsDistName As String
Public att As String
Public hilsen As String
Public side As String
Public sideaf As String
Public sprog As String
Public før
Public anden
Private Sub dansk_Click()
Me.att = "Att.:"
Me.hilsen = "Med venlig hilsen"
Me.sprog = "dansk"
ActiveDocument.Bookmarks("side").Select
Selection.TypeText Text:="Side"
ActiveDocument.Bookmarks("sideaf").Select
Selection.TypeText Text:="af"
ActiveDocument.ActiveWindow.View.Type = wdPrintView
End Sub
Private Sub engelsk_Click()
Me.att = "Att.:"
Me.hilsen = "Best regards"
Me.sprog = "engelsk"
ActiveDocument.Bookmarks("side").Select
Selection.TypeText Text:="Page"
ActiveDocument.Bookmarks("sideaf").Select
Selection.TypeText Text:="of"
ActiveDocument.ActiveWindow.View.Type = wdPrintView
End Sub
Private Sub tysk_Click()
Me.att = "Z.Hd.:"
Me.hilsen = "Mit freundlichen Grüssen"
Me.side = "Seite"
Me.sideaf = "von"
Me.sprog = "tysk"
ActiveDocument.Bookmarks("side").Select
Selection.TypeText Text:="Seite"
ActiveDocument.Bookmarks("sideaf").Select
Selection.TypeText Text:="von"
ActiveDocument.ActiveWindow.View.Type = wdPrintView
End Sub
Private Sub UserForm_Terminate()
ActiveDocument.Close False
End Sub
Sub find_bruger()
'Tøm felter for tidligere brev
tbModtager.Text = ""
tbFirma.Text = ""
tbAdresse.Text = ""
tbBy.Text = ""
tbOverskrift.Text = ""
'TextBox1.Text = ""
'rtbBrev.Text = ""
tbModtagerTlf.Text = ""
tbModtagerMobil.Text = ""
tbModtagerFax.Text = ""
' Create the connection and command object.
Set oConnection1 = CreateObject("ADODB.Connection")
Set oCommand1 = CreateObject("ADODB.Command")
' Open the connection.
oConnection1.Provider = "ADsDSOObject" ' This is the ADSI OLE-DB provider name
oConnection1.Open "Active Directory Provider"
' Create a command object for this connection.
Set oCommand1.ActiveConnection = oConnection1
' Compose a search string.
oCommand1.CommandText = "select sAMAccountName, distinguishedName, name, telephoneNumber, mail, title, l, mobile " & _
"from 'LDAP://server'" & _
"WHERE objectCategory='Person'" & _
"AND objectClass='user'" & _
"AND department=100" & _
"OR department=210" & _
"OR department=220" & _
"OR department=230" & _
"OR department=300" & _
"OR department=310" & _
"OR department=400" & _
"OR department=410" & _
"OR department=700"
' Execute the query.
Set rs = oCommand1.Execute
' Hvilken bruger skal markeres
Dim wshNetwork
Set wshNetwork = CreateObject("WScript.Network")
user = wshNetwork.UserName
'Domain = wshNetwork.userdomain
'computer = wshNetwork.ComputerName
'--------------------------------------
' Navigate the record set
' select the user
'--------------------------------------
While Not rs.EOF
startBoks.cbAfsender.AddItem rs.Fields("name")
If LCase(user) = LCase(rs.Fields("sAMAccountName")) Then
For i = 0 To cbAfsender.ListCount - 1
If cbAfsender.List(i) = rs.Fields("name") Then
cbAfsender.ListIndex = i
Exit For
End If
Next
End If
' Debug.Print rs.Fields("sAMAccountName")
' Debug.Print rs.Fields("name") & ", " & rs.Fields("telephoneNumber") & ", " & rs.Fields("mail") & ", " & rs.Fields("title") & ", " & rs.Fields("facsimileTelephoneNumber") & ", " & rs.Fields("mobile") & ", ---- " & rs.Fields("distinguishedName")
rs.MoveNext
Wend
End Sub
Private Sub cbAfsender_Change()
rs.MoveFirst
Dim found As Boolean
found = False
While (Not found) And (Not rs.EOF)
If LCase(cbAfsender.Value) = LCase(rs.Fields("name")) Then
found = True
Me.afsName = rs.Fields("name")
Me.afsTlf = rs.Fields("telephoneNumber")
Me.afsMail = rs.Fields("mail")
' Me.afsTitle = rs.Fields("title")
Me.afsMobile = rs.Fields("mobile")
Me.afsDistName = rs.Fields("distinguishedName")
Dim strAfsender As String
If Not IsNull(Me.afsName) Then
strAfsender = Me.afsName
End If
'If Not IsNull(Me.afsTitle) Then
' strAfsender = strAfsender & vbCrLf & Me.afsTitle
'End If
If Not IsNull(Me.afsMail) Then
strAfsender = strAfsender & vbCrLf & Me.afsMail
End If
If Not IsNull(Me.afsTlf) Then
strAfsender = strAfsender & vbCrLf & Me.afsTlf
End If
If Not IsNull(Me.afsMobile) Then
strAfsender = strAfsender & vbCrLf & Me.afsMobile
End If
Me.tbAfsenderdata = strAfsender
End If
rs.MoveNext
Wend
End Sub
Private Sub cdAnnuller_Click()
If MsgBox("Vil du lukke uden at oprette og gemme brevet?", vbYesNo, "Lukke dokument") = vbYes Then
startBoks.Hide
ActiveWindow.Close SaveChanges:=False
End If
End Sub
Private Sub opret_Click()
On Error Resume Next:
'afsender
Dim strAfsender As String
If Not IsNull(Me.afsName) Then
strAfsender = Me.afsName & vbCrLf
End If
'If Not IsNull(Me.afsTitle) Then
' strAfsender = strAfsender & vbCrLf & Me.afsTitle
'End If
If Not IsNull(Me.afsTlf) Then
strAfsender = strAfsender & vbCrLf & "Direkte tel.: " & Me.afsTlf
End If
If Not IsNull(Me.afsMobile) Then
strAfsender = strAfsender & vbCrLf & "Mobil tlf.: " & Me.afsMobile
End If
If Not IsNull(Me.afsMail) Then
strAfsender = strAfsender & vbCrLf & Me.afsMail
End If
'ActiveDocument.FormFields("afsender").Range.Text = strAfsender
'ActiveDocument.FormFields("afsender").Range.Text = Replace(strAfsender, vbCrLf & vbCrLf, "")
'Tjek for om alle nødvendige modtagerinfo er udfyldt, ellers oprettes dokumentet ikke.
If startBoks.tbFirma.Value = "" Then
MsgBox "Du har ikke udfyldt firmanavnet"
ElseIf startBoks.tbAdresse.Value = "" Then
MsgBox "Du har ikke udfyldt firmaadressen"
ElseIf startBoks.tbBy.Value = "" Then
MsgBox "Du har ikke udfyldt postnr. og/eller by"
ElseIf startBoks.tbModtager.Value = "" Then
MsgBox "Du har ikke udfyldt modtageren af brevet"
ElseIf startBoks.tbOverskrift.Value = "" Then
MsgBox "Du har ikke givet brevet en overskrift"
'ElseIf startBoks.TextBox1.Value = "" Then
' MsgBox "Du har ikke skrevet selve brevet"
ElseIf sprog = "" Then
MsgBox "Du har ikke valgt et sprog til stavekontrollen"
ElseIf sprog = "" Then
MsgBox "Du har ikke valgt et sprog til stavekontrollen"
Else
'End If
Set Range = ActiveDocument.Range
If sprog = "dansk" Then
Range.LanguageID = wdDanish
ElseIf sprog = "engelsk" Then
Range.LanguageID = wdEnglishUK
ElseIf sprog = "tysk" Then
Range.LanguageID = wdGerman
End If
'ElseIf sprog = "" Then
'If Not IsNull(sprog) Then
'side -> Da formular-felter ikke kan laves i sidehoved/fod ligger de i selve dokumentet.
'ActiveDocument.FormFields("side").Range.Text = side
'ActiveDocument.FormFields("af").Range.Text = sideaf
'hilsen
ActiveDocument.FormFields("hilsen").Range.Text = hilsen
'afsender
ActiveDocument.FormFields("afsender").Range.Text = strAfsender
'modtagerfimra
Dim strModtager As String
strModtager = startBoks.tbFirma.Value & vbCrLf & startBoks.tbAdresse.Value & vbCrLf _
& startBoks.tbBy.Value
ActiveDocument.FormFields("modtager").Range.Text = strModtager
'modtagerperson
ActiveDocument.FormFields("person").Range.Text = att & " " & startBoks.tbModtager.Value
'modtagertlf
ActiveDocument.FormFields("modtagerTlf").Range.Text = startBoks.tbModtagerTlf.Value
'modtagerfax
ActiveDocument.FormFields("modtagerFax").Range.Text = startBoks.tbModtagerFax.Value
'modtagermobil
ActiveDocument.FormFields("modtagerMobil").Range.Text = startBoks.tbModtagerMobil.Value
'overskrift
ActiveDocument.FormFields("overskrift").Range.Text = startBoks.tbOverskrift.Value
'brev
'ActiveDocument.FormFields("brev").Range.Text = startBoks.TextBox1.Text
'Skjuler formen
startBoks.Hide
ActiveDocument.ActiveWindow.View.Type = wdPrintView
'Udføre stavekontrol
Range.CheckSpelling
'Sætte Word til automatisk at detektere sproget, hvis der skrives mere
Application.CheckLanguage = True
'Gem dokument
ActiveDocument.Save
' Skifter til udskriftslayout og sidebredde
ActiveDocument.ActiveWindow.View.Type = wdPrintView
ActiveDocument.ActivePane.View.Zoom.PageFit = wdPageFitBestFit
End If
'End If
End Sub
Fax:
----------------------------------------------------------------
Public rs
Public afsName, afsTlf, afsMail, afsTitle, afsMobile, afsDistName As String
Public att As String
Public hilsen As String
Public side As String
Public sideaf As String
Public sprog As String
Public før
Public anden
Private Sub cbInformation_Click()
End Sub
Private Sub dansk_Click()
Me.att = "Att.:"
Me.hilsen = "Med venlig hilsen"
Me.sprog = "dansk"
ActiveDocument.ActiveWindow.View.Type = wdPrintView
End Sub
Private Sub engelsk_Click()
Me.att = "Att.:"
Me.hilsen = "Best regards"
Me.sprog = "engelsk"
ActiveDocument.ActiveWindow.View.Type = wdPrintView
End Sub
Private Sub tysk_Click()
Me.att = "Z.Hd.:"
Me.hilsen = "Mit freundlichen Grüssen"
Me.side = "Seite"
Me.sideaf = "von"
Me.sprog = "tysk"
ActiveDocument.ActiveWindow.View.Type = wdPrintView
End Sub
Private Sub UserForm_Terminate()
ActiveDocument.Close False
End Sub
Sub find_bruger()
'Tøm felter for tidligere brev
tbModtager.Text = ""
tbAtt.Text = ""
'tbOverskrift.Text = ""
tbModtagerFax.Text = ""
tbSidetal = ""
tbModtagerFax = ""
cbGennemsyn = False
cbVigtigt = False
cbSvar = False
cbKommentar = False
cbInformation = False
dansk = False
engelsk = False
tysk = False
' Create the connection and command object.
Set oConnection1 = CreateObject("ADODB.Connection")
Set oCommand1 = CreateObject("ADODB.Command")
' Open the connection.
oConnection1.Provider = "ADsDSOObject" ' This is the ADSI OLE-DB provider name
oConnection1.Open "Active Directory Provider"
' Create a command object for this connection.
Set oCommand1.ActiveConnection = oConnection1
' Compose a search string.
oCommand1.CommandText = "select sAMAccountName, distinguishedName, name, telephoneNumber, mail, title, l, mobile " & _
"from 'LDAP://srv-exch'" & _
"WHERE objectCategory='Person'" & _
"AND objectClass='user'" & _
"AND department=100" & _
"OR department=210" & _
"OR department=220" & _
"OR department=230" & _
"OR department=300" & _
"OR department=310" & _
"OR department=400" & _
"OR department=410" & _
"OR department=700"
' Execute the query.
Set rs = oCommand1.Execute
' Hvilken bruger skal markeres
Dim wshNetwork
Set wshNetwork = CreateObject("WScript.Network")
user = wshNetwork.UserName
'Domain = wshNetwork.userdomain
'computer = wshNetwork.ComputerName
'--------------------------------------
' Navigate the record set
' select the user
'--------------------------------------
While Not rs.EOF
faxStartBoks.cbAfsender.AddItem rs.Fields("name")
If LCase(user) = LCase(rs.Fields("sAMAccountName")) Then
For i = 0 To cbAfsender.ListCount - 1
If cbAfsender.List(i) = rs.Fields("name") Then
cbAfsender.ListIndex = i
Exit For
End If
Next
End If
' Debug.Print rs.Fields("sAMAccountName")
' Debug.Print rs.Fields("name") & ", " & rs.Fields("telephoneNumber") & ", " & rs.Fields("mail") & ", " & rs.Fields("title") & ", " & rs.Fields("facsimileTelephoneNumber") & ", " & rs.Fields("mobile") & ", ---- " & rs.Fields("distinguishedName")
rs.MoveNext
Wend
End Sub
Private Sub cbAfsender_Change()
rs.MoveFirst
Dim found As Boolean
found = False
While (Not found) And (Not rs.EOF)
If LCase(cbAfsender.Value) = LCase(rs.Fields("name")) Then
found = True
Me.afsName = rs.Fields("name")
Me.afsTlf = rs.Fields("telephoneNumber")
Me.afsMail = rs.Fields("mail")
' Me.afsTitle = rs.Fields("title")
Me.afsMobile = rs.Fields("mobile")
Me.afsDistName = rs.Fields("distinguishedName")
Dim strAfsender As String
If Not IsNull(Me.afsName) Then
strAfsender = Me.afsName
End If
'If Not IsNull(Me.afsTitle) Then
' strAfsender = strAfsender & vbCrLf & Me.afsTitle
'End If
If Not IsNull(Me.afsMail) Then
strAfsender = strAfsender & vbCrLf & Me.afsMail
End If
If Not IsNull(Me.afsTlf) Then
strAfsender = strAfsender & vbCrLf & Me.afsTlf
End If
If Not IsNull(Me.afsMobile) Then
strAfsender = strAfsender & vbCrLf & Me.afsMobile
End If
Me.tbAfsenderdata = strAfsender
End If
rs.MoveNext
Wend
End Sub
Private Sub cdAnnuller_Click()
If MsgBox("Vil du lukke uden at oprette og gemme brevet?", vbYesNo, "Lukke dokument") = vbYes Then
faxStartBoks.Hide
ActiveWindow.Close SaveChanges:=False
End If
End Sub
Private Sub opret_Click()
On Error Resume Next:
'afsender
Dim strAfsender As String
If Not IsNull(Me.afsName) Then
strAfsender = Me.afsName
End If
If Not IsNull(Me.afsTlf) Then
strAfsender = strAfsender & vbCrLf & "Direkte tel.: " & Me.afsTlf
End If
If Not IsNull(Me.afsMobile) Then
strAfsender = strAfsender & vbCrLf & "Mobil tlf.: " & Me.afsMobile
End If
If Not IsNull(Me.afsMail) Then
strAfsender = strAfsender & vbCrLf & "Mail: " & Me.afsMail
End If
'Fobian kode start
Dim Mangler As String
'Tjek for om alle nødvendige modtagerinfo er udfyldt, ellers oprettes dokumentet ikke.
If faxStartBoks.tbAtt.Value = "" Then Mangler = "Du har ikke udfyldt attention-feltet"
If faxStartBoks.tbModtager.Value = "" Then Mangler = Mangler & vbLf & "Du har ikke udfyldt modtageren af faxen"
If faxStartBoks.tbModtagerFax.Value = "" Then Mangler = Mangler & vbLf & "Du har glemte at udfylde fax-nr"
If faxStartBoks.cbVigtigt.Value = False _
And faxStartBoks.cbSvar.Value = False _
And faxStartBoks.cbKommentar.Value = False _
And faxStartBoks.cbGennemsyn.Value = False _
And faxStartBoks.cbInformation.Value = False _
Then Mangler = Mangler & vbLf & "Du har ikke udfyldt én af følgende 5 punkter: Vigtigt, Svar udbedes, Kommetar udbedes, Til gennemsyn eller Til information."
If faxStartBoks.tbSidetal.Value = "" Then Mangler = Mangler & vbLf & "Du har ikke udfyldt sideantallet"
' ElseIf sprog = "" Then
' MsgBox "Du har ikke valgt et sprog til stavekontrollen"
If Mangler <> "" Then
MsgBox Mangler
'Fobian kode slut
Else
'End If
Set Range = ActiveDocument.Range
If sprog = "dansk" Then
Range.LanguageID = wdDanish
ElseIf sprog = "engelsk" Then
Range.LanguageID = wdEnglishUK
ElseIf sprog = "tysk" Then
Range.LanguageID = wdGerman
End If
'MsgBox "Test"
' Checkboxene
If cbGennemsyn.Value = True Then
ActiveDocument.FormFields("gennemsyn").CheckBox.Value = Checked
End If
If cbKommentar.Value = True Then
ActiveDocument.FormFields("kommentar").CheckBox.Value = Checked
End If
If cbInformation.Value = True Then
ActiveDocument.FormFields("information").CheckBox.Value = Checked
End If
If cbSvar.Value = True Then
ActiveDocument.FormFields("svar").CheckBox.Value = Checked
End If
If cbVigtigt.Value = True Then
ActiveDocument.FormFields("vigtigt").CheckBox.Value = Checked
End If
'hilsen
ActiveDocument.FormFields("hilsen").Range.Text = hilsen
'afsender
ActiveDocument.FormFields("afsender").Range.Text = strAfsender
'fra
ActiveDocument.FormFields("fra").Range.Text = Me.afsName
'modtagerfimra
Dim strModtager As String
strModtager = faxStartBoks.tbModtager.Value
ActiveDocument.FormFields("modtager").Range.Text = strModtager
'modtagerperson
ActiveDocument.FormFields("att").Range.Text = faxStartBoks.tbAtt.Value
'Vedrørende/overskrift
' ActiveDocument.FormFields("overskrift").Range.Text = faxStartBoks.tbOverskrift.Value
'modtagerfax
ActiveDocument.FormFields("fax").Range.Text = faxStartBoks.tbModtagerFax.Value
'brev
'ActiveDocument.FormFields("tekst").Range.Text = faxStartBoks.tbFax.Text
'side
ActiveDocument.FormFields("sideantal").Range.Text = faxStartBoks.tbSidetal.Text
'Skjuler formen
faxStartBoks.Hide
ActiveDocument.ActiveWindow.View.Type = wdPrintView
'Udføre stavekontrol
Range.CheckSpelling
'Sætte Word til automatisk at detektere sproget, hvis der skrives mere
Application.CheckLanguage = True
'Gem dokument
ActiveDocument.Save
ActiveDocument.ActiveWindow.View.Type = wdPrintView
ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True, Password:="skabelon"
End If
End Sub
----------------------------------------------------------------
Pointene bliver fordelt lige mellem de 2 skabeloner.