#16
|
|||
|
|||
Hi,
This attachment is a redacted code. When you open the file yo can click the "Test" button. It produce a msgbox letting you know which code worked. |
#17
|
|||
|
|||
@charlesdh: Thank you. I will go through what you've sent and get back to you.
|
#18
|
|||
|
|||
@charlesdh: It seems like the code will work now, thank you. I only want to ask something...
Some lines of your code said these... Code:
''' If OS is Mac it comes here Call Select_File_Or_Files_Mac Else ''''' If OS is PC it comes here '''' Call Gather_Data |
#19
|
|||
|
|||
Hi,
I put the remarks in to tell you if the user was using a mac or pc. and call the correct code. For the call you need to for the "PC" you need to change the "Call Your Pc code". For the "Mac" code I changed my original code name to what you see in the call for Mac. If the user has a PC the pc code will run. If Mac the code for the mac will run. Last edited by charlesdh; 01-24-2015 at 02:37 PM. Reason: corrected info |
#20
|
|||
|
|||
Alright. Look at what I did and tell me if it's correct please (you may not really bother the part that opens a Word document since you said you don't deal with Word), simply cross check the syntax and tell me if it's correct, though I ran it om my system, but I'm afraid it might not run on the MAC OS. The codes are below. Thank you.
Code:
Sub Get_Os() Dim TheOS As String TheOS = Application.OperatingSystem ''' this line checks for the Operating system If Left(TheOS, 7) <> "Windows" Then ''' If OS is Mac it comes here Call Select_File_Or_Files_Mac Else ''''' If OS is PC it comes here '''' Call ImportWordTable End If End Sub Sub ImportWordTable() Dim wdDoc As Object Dim wdFileName As Variant Dim TableNo As Integer 'table number in Word Dim wordRow As Long 'row index in Word Dim wordCol As Integer 'column index in Word Dim ExcelRow As Long 'row index in Excel Dim ExcelCol As Integer 'column index in Excel Dim ColToStart As Integer wdFileName = Application.GetOpenFilename("Word files (*.docx),*.docx", , _ "Browse for file containing table to be imported") If wdFileName = False Then Exit Sub '(user cancelled import file browser) Set wdDoc = GetObject(wdFileName) 'open Word file With wdDoc If wdDoc.tables.Count = 0 Then MsgBox "This document contains no tables", _ vbExclamation, "Import Word Table" Else ExcelRow = 0 Sheets.Add after:=Sheets(Worksheets.Count) ColToStart = 1 For TableNo = 1 To wdDoc.tables.Count With .tables(TableNo) 'copy cell contents from Word table cells to Excel cells If TableNo > 1 Then ColToStart = 2 End If For wordCol = ColToStart To .Columns.Count ExcelCol = ExcelCol + 1 For ExcelRow = 1 To .Rows.Count On Error Resume Next ActiveSheet.Cells(ExcelCol, ExcelRow) = WorksheetFunction.Clean(.cell(ExcelRow, wordCol).Range.Text) On Error GoTo 0 Next ExcelRow Next wordCol End With Next TableNo End If End With Set wdDoc = Nothing End Sub Sub Select_File_Or_Files_Mac() '''''' Code for Mac Dim MyPath As String Dim MyScript As String Dim MyFiles As String Dim MySplit As Variant Dim N As Long Dim Fname As String Dim mybook As Workbook '''''''''''''' Variables from PC code ''''' Application.ScreenUpdating = False Application.EnableEvents = False Dim s Dim i As Long Dim Myrow As Long Dim Clrow As Long Dim c As Variant Dim Mcat As String '' Main Catagory Dim Scat As String '' Sub Catagory Dim Ncat As String Dim Rws As Worksheet Dim Cvsws As Worksheet Dim Pwb As Workbook Dim Cvwb As Workbook '''''''''''''''''''' Dim ww As String ww = ThisWorkbook.Path On Error Resume Next MyPath = MacScript("return (path to documents folder) as String") 'Or use MyPath = "Macintosh HD:Users:Ron:Desktop:TestFolder:" ' In the following statement, change true to false in the line "multiple ' selections allowed true" if you do not want to be able to select more ' than one file. Additionally, if you want to filter for multiple files, change ' {""com.microsoft.Excel.xls""} to ' {""com.microsoft.excel.xls"",""public.comma-separated-values-text""} ' if you want to filter on xls and csv files, for example. MyScript = _ "set applescript's text item delimiters to "","" " & vbNewLine & _ "set theFiles to (choose file of type " & _ " {""org.openxmlformats.wordprocessingml.document""} " & _ "with prompt ""Please select a file or files"" default location alias """ & _ MyPath & """ multiple selections allowed true) as string" & vbNewLine & _ "set applescript's text item delimiters to """" " & vbNewLine & _ "return theFiles" MyFiles = MacScript(MyScript) On Error GoTo 0 If MyFiles <> "" Then With Application .ScreenUpdating = False .EnableEvents = False End With MySplit = Split(MyFiles, ",") For N = LBound(MySplit) To UBound(MySplit) ' Get the file name only and test to see if it is open. Fname = Right(MySplit(N), Len(MySplit(N)) - InStrRev(MySplit(N), Application.PathSeparator, , 1)) If bIsBookOpen(Fname) = False Then Set mybook = Nothing On Error Resume Next Set mybook = Workbooks.Open(MySplit(N)) On Error GoTo 0 '''''''''''''''''''' '''''''''''''' MsgBox "Mac code ''''" ''''''''''''''''''''''''' If Not mybook Is Nothing Then MsgBox "You open this file : " & MySplit(N) & vbNewLine & _ "And after you press OK it will be closed" & vbNewLine & _ "without saving, replace this line with your own code." mybook.Close SaveChanges:=False End If Else MsgBox "We skipped this file : " & MySplit(N) & " because it Is already open." End If Next N With Application .ScreenUpdating = True .EnableEvents = True End With End If End Sub Function bIsBookOpen(ByRef szBookName As String) As Boolean ' Contributed by Rob Bovey On Error Resume Next bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing) End Function |
#21
|
|||
|
|||
Hi,
I'll download the file and make the correction for the "Mac" code. The code you have now is for a file that I was working on. |
#22
|
|||
|
|||
@charlesdh: Alright, I will be expecting the corrected code Thank you very much!
|
#23
|
|||
|
|||
HI,
Sorry to say this line of code fails "TheOS = Application.OperatingSystem" in "Word" for "MAC". I do not know if it works in "PC" Word. You need to find the equivlant code for "Word". The code I supplied was for "Excel". |
#24
|
|||
|
|||
While line of the core are you referring to?
|
#25
|
|||
|
|||
Okay, do you have a MAC OS you can check it on?
|
#26
|
|||
|
|||
If you have a MAC OS, please help me check this code whether it will run on it. Thank you. The code is below...
Code:
Sub WINorMAC() ' Test for the operating system. If Not Application.OperatingSystem Like "*Mac*" Then ' Is Windows. Call ImportWordTable Else ' Is a Mac and will test if running Excel 2011 or higher. If Val(Application.Version) > 14 Then Call ImportWordTable End If End If End Sub 'Sub Get_Os() 'Dim TheOS As String 'TheOS = Application.OperatingSystem ''' this line checks for the Operating system 'If Left(TheOS, 7) <> "Windows" Then ''' If OS is Mac it comes here 'Call Select_File_Or_Files_Mac 'Else ''''' If OS is PC it comes here '''' 'Call ImportWordTable 'End If 'End Sub Sub ImportWordTable() Dim wdDoc As Object Dim wdFileName As Variant Dim TableNo As Integer 'table number in Word Dim wordRow As Long 'row index in Word Dim wordCol As Integer 'column index in Word Dim ExcelRow As Long 'row index in Excel Dim ExcelCol As Integer 'column index in Excel Dim ColToStart As Integer wdFileName = Application.GetOpenFilename("Word files (*.docx),*.docx", , _ "Browse for file containing table to be imported") If wdFileName = False Then Exit Sub '(user cancelled import file browser) Set wdDoc = GetObject(wdFileName) 'open Word file With wdDoc If wdDoc.tables.Count = 0 Then MsgBox "This document contains no tables", _ vbExclamation, "Import Word Table" Else ExcelRow = 0 Sheets.Add after:=Sheets(Worksheets.Count) ColToStart = 1 For TableNo = 1 To wdDoc.tables.Count With .tables(TableNo) 'copy cell contents from Word table cells to Excel cells If TableNo > 1 Then ColToStart = 2 End If For wordCol = ColToStart To .Columns.Count ExcelCol = ExcelCol + 1 For ExcelRow = 1 To .Rows.Count On Error Resume Next ActiveSheet.Cells(ExcelCol, ExcelRow) = WorksheetFunction.Clean(.cell(ExcelRow, wordCol).Range.Text) On Error GoTo 0 Next ExcelRow Next wordCol End With Next TableNo End If End With Set wdDoc = Nothing End Sub Sub Select_File_Or_Files_Mac() '''''' Code for Mac Dim MyPath As String Dim MyScript As String Dim MyFiles As String Dim MySplit As Variant Dim N As Long Dim Fname As String Dim mybook As Workbook '''''''''''''' Variables from PC code ''''' Application.ScreenUpdating = False Application.EnableEvents = False Dim s Dim i As Long Dim Myrow As Long Dim Clrow As Long Dim c As Variant Dim Mcat As String '' Main Catagory Dim Scat As String '' Sub Catagory Dim Ncat As String Dim Rws As Worksheet Dim Cvsws As Worksheet Dim Pwb As Workbook Dim Cvwb As Workbook '''''''''''''''''''' Dim ww As String ww = ThisWorkbook.Path On Error Resume Next MyPath = MacScript("return (path to documents folder) as String") 'Or use MyPath = "Macintosh HD:Users:Ron:Desktop:TestFolder:" ' In the following statement, change true to false in the line "multiple ' selections allowed true" if you do not want to be able to select more ' than one file. Additionally, if you want to filter for multiple files, change ' {""com.microsoft.Excel.xls""} to ' {""com.microsoft.excel.xls"",""public.comma-separated-values-text""} ' if you want to filter on xls and csv files, for example. MyScript = _ "set applescript's text item delimiters to "","" " & vbNewLine & _ "set theFiles to (choose file of type " & _ " {""org.openxmlformats.wordprocessingml.document""} " & _ "with prompt ""Please select a file or files"" default location alias """ & _ MyPath & """ multiple selections allowed true) as string" & vbNewLine & _ "set applescript's text item delimiters to """" " & vbNewLine & _ "return theFiles" MyFiles = MacScript(MyScript) On Error GoTo 0 If MyFiles <> "" Then With Application .ScreenUpdating = False .EnableEvents = False End With MySplit = Split(MyFiles, ",") For N = LBound(MySplit) To UBound(MySplit) ' Get the file name only and test to see if it is open. Fname = Right(MySplit(N), Len(MySplit(N)) - InStrRev(MySplit(N), Application.PathSeparator, , 1)) If bIsBookOpen(Fname) = False Then Set mybook = Nothing On Error Resume Next Set mybook = Workbooks.Open(MySplit(N)) On Error GoTo 0 '''''''''''''''''''' '''''''''''''' MsgBox "Mac code ''''" ''''''''''''''''''''''''' If Not mybook Is Nothing Then MsgBox "You open this file : " & MySplit(N) & vbNewLine & _ "And after you press OK it will be closed" & vbNewLine & _ "without saving, replace this line with your own code." mybook.Close SaveChanges:=False End If Else MsgBox "We skipped this file : " & MySplit(N) & " because it Is already open." End If Next N With Application .ScreenUpdating = True .EnableEvents = True End With End If End Sub Function bIsBookOpen(ByRef szBookName As String) As Boolean ' Contributed by Rob Bovey On Error Resume Next bIsBookOpen = Not (Application.Workbooks(szBookName) Is Nothing) End Function |
#27
|
|||
|
|||
Hi,
I have a Mac. And the code fails in word for the mac. This part of the code fails. Mac word does not recognize it. Also you modified code does not work it errors on the same part as below. "Application.OperatingSystem " Am going off line. But will ck later to see if I can find a work around. |
#28
|
|||
|
|||
I will be expecting your arrival and help please. Thank you.
|
#29
|
|||
|
|||
Hi,
It took awhile. But, see if this helps. I tested on a mac and it goes o the mac code. Not sure haw this will work on a PC. Code:
Dim MyFiles As String Sub Get_Os() Dim info As System Dim myos myos = Application.System.OperatingSystem If myos = "Macintosh" Then ''' system is Mac '' Call GetTextFilesOnMac Else ''' system is PC Call ImportWordTable End If End Sub Sub ImportWordTable() Dim wdDoc As Object Dim wdFileName As Variant Dim TableNo As Integer 'table number in Word Dim wordRow As Long 'row index in Word Dim wordCol As Integer 'column index in Word Dim ExcelRow As Long 'row index in Excel Dim ExcelCol As Integer 'column index in Excel Dim ColToStart As Integer wdFileName = Application.GetOpenFilename("Word files (*.docx),*.docx", , _ "Browse for file containing table to be imported") If wdFileName = False Then Exit Sub '(user cancelled import file browser) Set wdDoc = GetObject(wdFileName) 'open Word file With wdDoc If wdDoc.Tables.Count = 0 Then MsgBox "This document contains no tables", _ vbExclamation, "Import Word Table" Else ExcelRow = 0 Sheets.Add After:=Sheets(Worksheets.Count) ColToStart = 1 For TableNo = 1 To wdDoc.Tables.Count With .Tables(TableNo) 'copy cell contents from Word table cells to Excel cells If TableNo > 1 Then ColToStart = 2 End If For wordCol = ColToStart To .Columns.Count ExcelCol = ExcelCol + 1 For ExcelRow = 1 To .Rows.Count On Error Resume Next ActiveSheet.Cells(ExcelCol, ExcelRow) = WorksheetFunction.Clean(.Cell(ExcelRow, wordCol).Range.Text) On Error GoTo 0 Next ExcelRow Next wordCol End With Next TableNo End If End With Set wdDoc = Nothing End Sub Sub GetTextFilesOnMac() Dim vFileName As Variant Dim wdFileName As Variant Dim TableNo As Integer 'table number in Word Dim wordRow As Long 'row index in Word Dim wordCol As Integer 'column index in Word Dim ExcelRow As Long 'row index in Excel Dim ExcelCol As Integer 'column index in Excel Dim ColToStart As Integer 'Call the function to return the files vFileName = Select_File_Or_Files_Mac 'If it's empty then the user cancelled 'If IsEmpty(vFileName) Then Exit Sub Documents.Open fileName:=MyFiles, ConfirmConversions:=False, _ ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _ PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _ WritePasswordTemplate:="", Format:=wdOpenFormatAuto ''''''''''''''''''''' wdDoc = ActiveDocument With wdDoc If wdDoc.Tables.Count = 0 Then MsgBox "This document contains no tables", _ vbExclamation, "Import Word Table" Else ExcelRow = 0 'Sheets.Add After:=Sheets(Worksheets.Count) ColToStart = 1 For TableNo = 1 To wdDoc.Tables.Count With .Tables(TableNo) 'copy cell contents from Word table cells to Excel cells If TableNo > 1 Then ColToStart = 2 End If For wordCol = ColToStart To .Columns.Count ExcelCol = ExcelCol + 1 For ExcelRow = 1 To .Rows.Count On Error Resume Next ActiveSheet.Cells(ExcelCol, ExcelRow) = WorksheetFunction.Clean(.Cell(ExcelRow, wordCol).Range.Text) On Error GoTo 0 Next ExcelRow Next wordCol End With Next TableNo End If End With Set wdDoc = Nothing End Sub Function Select_File_Or_Files_Mac() As Variant 'Uses AppleScript to select files on a Mac Dim MyPath As String, MyScript As String, MySplit As Variant 'Get the documents folder as a default On Error Resume Next MyPath = MacScript("return (path to documents folder) as String") 'Set up the Apple Script to look for text files MyScript = "set applescript's text item delimiters to "","" " & vbNewLine & _ "set theFiles to (choose file of type " & " {""org.openxmlformats.wordprocessingml.document""} " & _ "with prompt ""Please select a file or files"" default location alias """ & _ MyPath & """ multiple selections allowed true) as string" & vbNewLine & _ "set applescript's text item delimiters to """" " & vbNewLine & _ "return theFiles" 'Run the Apple Script MyFiles = MacScript(MyScript) On Error GoTo 0 End Function |
#30
|
|||
|
|||
Oh, thank you very! I will use it and let you know how it worked.
|
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Excel 2008 vs Excel 2011 for Mac | nfotx | Excel | 0 | 12-05-2014 03:48 PM |
Index Hyperlink Workaround | Phil H | Word VBA | 9 | 10-30-2014 05:14 AM |
Workaround to have UserForm open from Web Link | Kirsti | Word VBA | 11 | 08-23-2012 07:05 PM |
Excel 2011 can't open old Excel 98 or Excel X files | FLJohnson | Excel | 8 | 05-09-2012 11:26 PM |
MAC PPT 2011 compatibility with Windows | stoneygeorge | PowerPoint | 0 | 08-05-2011 10:00 AM |