convert a template + macros from Win to Mac?

A

and

Hi,

Does anyone know if it is possible to share a Windows developed template
with a user form and macros with people using Macs?

And if it is possible, how should I proceed? The user form code is
displayed below. I know this can be exchanged by e-mail (and copied and
pasted), but how about the user form layout? The buttons etcetera. And
how about the menu command for accessing these macros that this is in my
Windows template?

TIA,
H.


==================
User Form Code (some global variables are declared in the Module; not in
the user form, but that can be changed)
==================

Option Explicit
Const TagText = "AutoCorrect Backup Document"

Private Sub UserForm_Initialize()
frmAutoCorrect.Caption = strProcedureName & " - " & strVersion
End Sub

Private Sub btnBackup_Click()
Dim lngTeller As Long

frmAutoCorrect.Hide
Application.ScreenUpdating = False

Application.Documents.Add

lngTeller = GetAutoCorrectEntries()

With Selection
.SplitTable
.TypeText Text:=TagText
.TypeParagraph
End With

With ActiveDocument.Sentences(1)
.Bold = True
.Font.Size = 14
End With

Application.StatusBar = "Saving..."
If SaveACDoc = True Then
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
End If

Application.ScreenUpdating = True
frmAutoCorrect.Show
End Sub

Private Sub btnClose_Click()
Unload Me
End Sub

Private Sub btnRestore_Click()
Dim ACFileName, Title As String
Dim MsgBoxButtons As Long, Response As Long, lngX As Long

frmAutoCorrect.Hide

MsgBoxButtons = vbYesNo + vbInformation + vbDefaultButton2
Title = strProcedureName & " - " & strVersion
Response = MsgBox("This will replace your current AutoCorrect entries
with entries from your backup document that contain the same name. Do
you wish to continue?", MsgBoxButtons, Title)
If Response = vbNo Then
GoTo bye:
End If

With Dialogs(wdDialogFileOpen)
.Name = "*.doc"
.Display
ACFileName = .Name
End With

If OpenACDoc(ACFileName) = True Then
lngX = RestoreACEntries()
ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
End If
bye:
System.Cursor = wdCursorNormal
frmAutoCorrect.Show
End Sub

Function RestoreACEntries()

Dim oDoc As Document, oACorrect As Object, oTable As Table, oRow As Row
Dim strName As String, strValue As String, strRTF As String, MyRange As
Range, RTFRange As Range
Dim lngX As Long

Err.Clear
On Error GoTo 0

If ActiveDocument.Words(1) = "AutoCorrect " Then
Set oDoc = ActiveDocument
Set oTable = oDoc.Tables(1)
Set oACorrect = Application.Autocorrect.Entries
Set MyRange = oTable.Cell(2, 1).Range
MyRange.End = MyRange.End - 1
System.Cursor = wdCursorWait

Do
Application.ScreenUpdating = False

strName = MyRange.Text
Set MyRange = MyRange.Next(wdCell)
MyRange.End = MyRange.End - 1

If Left$(Application.Version, 1) > "8" Then
If Not MyRange.Tables(1).Range.IsEqual(oTable.Range) Then
Application.Autocorrect.Entries.AddRichText strName,
MyRange
MyRange.Cut
If IsObjectValid(MyRange.Next(wdCell, 2)) Then
Set MyRange = MyRange.Next(wdCell, 2)
MyRange.End = MyRange.End - 1
GoTo NextLoop
Else
Exit Do
End If
End If

End If

strValue = MyRange.Text

Set RTFRange = MyRange.Next(wdCell)
RTFRange.End = RTFRange.End - 1
strRTF = RTFRange.Text

Application.StatusBar = "Adding AutoCorrect Entry: " & strName


If strRTF = "False" Then
Application.Autocorrect.Entries.Add Name:=strName,
Value:=strValue
Else
Application.Autocorrect.Entries.AddRichText strName, MyRange
End If

If IsObjectValid(RTFRange.Next(wdCell)) Then
Set MyRange = RTFRange.Next(wdCell)
MyRange.End = MyRange.End - 1
Else
Exit Do
End If
NextLoop:
Loop

System.Cursor = wdCursorNormal
Application.ScreenUpdating = True
MsgBox "Restore complete"

Else
MsgBox "This document is not in the correct format for an
AutoCorrect Backup document"
End If

RestoreACEntriesErrors:
Select Case Err.Number
Case 0:
Case Else
MsgBox ("There was an error. The document may be in the incorrect
format." & vbCr & Err.Number & " " & Err.Description & " " & strName)
End Select


End Function

Private Function GetAutoCorrectEntries()

Dim lngX As Long
Dim TotalACEntries As Long
Dim oRow As Row, MyRange As Range, oTable As Table, TestRange As Range

TotalACEntries = Application.Autocorrect.Entries.Count

Set oTable = ActiveDocument.Tables.Add(Range:=Selection.Range, _
NumRows:=(TotalACEntries + 1), NumColumns:=3)

Set MyRange = oTable.Cell(1, 1).Range
MyRange.Collapse
MyRange.Text = "Name"
Set MyRange = MyRange.Next(wdCell)
MyRange.Collapse
MyRange.Text = "Value"
Set MyRange = MyRange.Next(wdCell)
MyRange.Collapse
MyRange.Text = "RTF"
Set MyRange = MyRange.Next(wdCell)
MyRange.Collapse

For lngX = 1 To TotalACEntries

MyRange.Text = Application.Autocorrect.Entries(lngX).Name

Set MyRange = MyRange.Next(wdCell)
MyRange.Collapse

If Application.Autocorrect.Entries(lngX).RichText = True Then
Application.Autocorrect.Entries(lngX).Apply Range:=MyRange
Else
MyRange.Text = Application.Autocorrect.Entries(lngX).Value
End If

If Len(MyRange.Cells(1).Range.Text) = 2 Then
If Left$(Application.Version, 1) = "8" Then
MyRange.Text = "This entry couldn't be backed up because it
contained a table"
MsgBox "Entry " & Chr(34) &
Application.Autocorrect.Entries(lngX).Name & Chr(34) & " couldn't be
backed up, because it contained a table."
Else
Set MyRange = MyRange.Tables(1).Range
MyRange.Collapse wdCollapseEnd
End If
End If

Set MyRange = MyRange.Next(wdCell)
MyRange.Collapse

MyRange.Text = Application.Autocorrect.Entries(lngX).RichText

If lngX < TotalACEntries Then
Set MyRange = MyRange.Next(wdCell)
MyRange.Collapse
End If

Application.StatusBar = "Adding AutoCorrect Entry: " & lngX & " of
" & TotalACEntries

Next lngX

Set MyRange = Nothing
ActiveDocument.Range(0, 0).Select

End Function

Public Function SaveACDoc()
Dim MsgBoxButtons, Response As Long
Dim Title As String

SaveACDoc = True
Err.Clear
On Error GoTo SaveACDocErrors

With Dialogs(wdDialogFileSaveAs)
.Name = TagText
.Show
'ACFileName = .Name
End With

SaveACDocErrors:
Select Case Err.Number
Case 0:
Case 4198:
SaveACDoc = False
Case Else
MsgBoxButtons = vbYesNo + vbCritical + vbDefaultButton2 ' Define
buttons.

Title = Err.Number & " " & Err.Description

Response = MsgBox("There was an error. Do you want to want to
try again?", MsgBoxButtons, Title)
If Response = vbYes Then
Resume 'bring up SaveAs again
Else ' User choose No.
SaveACDoc = False
End If
End Select

End Function


Public Function OpenACDoc(ByVal ACFileOpenName As String) As Boolean

Dim MsgBoxButtons As Long

OpenACDoc = True
On Error GoTo OpenACDocErrors

Documents.Open Filename:=ACFileOpenName
On Error GoTo 0
Exit Function

OpenACDocErrors:
OpenACDoc = False

End Function

'************* btnDelAClist_Click() *****************
'Deletes all AutoCorrect entries from the list, after
'asking for confirmation first. HWA, January 28, 2004

Private Sub btnDelAClist_Click()

vResponse = MsgBox("This deletes all AutoCorrect entries! Continue?",
vbYesNo, strProcedureName)
If vResponse = vbNo Then
GoTo doei:
End If

Err.Clear
On Error GoTo AcErrors:

Application.ScreenUpdating = False

With Application.Autocorrect.Entries
While .Count > 0
.Item(1).Delete 'constant #1
Wend
End With


Application.ScreenUpdating = True
vResponse = MsgBox("All entries have been deleted.", vbInformation,
strProcedureName)

AcErrors:
Select Case Err.Number
Case 0:
Case Else
vResponse = MsgBox("Error deleting AutoCorrect entries." & vbCr &
"Error number: " & Err.Number & " " & Err.Description, vbCritical,
strProcedureName)
End Select

doei:

End Sub

Private Sub UserForm_Click()

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top