Rejje
06-01-2011, 04:05 AM
Hi!
The macro CreateWordDoc2 is supposed to create 2 different Word documents. But: A big problem has occured as I have added 2 macros that makes a lot of adjustment to worksheets that includes ranges to be copied by the macro.
Well, I think I have no choise but to show a lot of vba below in order to get correct help.
Public Enum WordConstants
wdInLine = 0
wdPasteText = 2
wdPasteEnhancedMetafile = 9
End Enum
Sub CreateWordDoc2()
Dim wrdApp As Object
Dim wrdDoc As Object
Dim wrdTbl As Word.Range
Dim xlDoc As Workbook
Dim i As Integer
On Error GoTo err_handler
Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True
Set wrdDoc = wrdApp.Documents.Open("C:\Documents and Settings\Rejje\Desktop\Kundpost\DOKUMENT\V608.dotx")
Set wrdTbl = wrdDoc.Content
Set xlDoc = ActiveWorkbook
Application.ScreenUpdating = False
Application.Calculation = xlManual
With xlDoc.Worksheets
Application.Goto Reference:=Range("V_20500").Value
Selection.Copy
End With
A LOT MORE OF COPYING FROM EXCEL THEN PASTING INTO WORD HAPPENS HERE!
With xlDoc
Application.Goto Reference:=Range("V_21200").Value
Application.Goto Reference:=Range("V_21200").Value
Selection.Copy
End With
' By Worksheet_Activate() Call AdjustWorksheet_SJR is made
' This triggers Excel to update and all Excel function RAND() will get a new value. NOT A PROBLEM!
A LOT MORE OF COPYING FROM EXCEL THEN PASTING INTO WORD HAPPENS HERE!
MkDir Range("V_20200").Value
' Range("V_20200").Value = "C:\Documents and Settings\Rejje\Desktop\74BDFF"
' A folder is created with a randomized name by Excel function RAND(). This folder is supposed to contain the 2 Word documents this macro creates.
If Dir(Range("V_21700").Value) <> "" Then
Kill Range("V_21700").Value
End If
' Range("V_21700").Value = "C:\Documents and Settings\Rejje\Desktop\74BDFF\1.docx"
wrdDoc.SaveAs Range("V_21700").Value, FileFormat _
:=wdFormatXMLDocument, LockComments:=False, Password:="", _
AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
:=False, SaveAsAOCELetter:=False
Set wrdDoc = Nothing
Set wrdDoc = wrdApp.Documents.Open("C:\Documents and Settings\Rejje\Desktop\Kundpost\DOKUMENT\V660.dotx")
With wrdApp
For i = 1 To Range("V_21850").Value
.Selection.TypeParagraph
Next i
End With
A LOT MORE OF COPYING FROM EXCEL THEN PASTING INTO WORD HAPPENS HERE!
With xlDoc
Application.Goto Reference:=Range("V_22000").Value
Application.Goto Reference:=Range("V_22000").Value
Selection.Copy
End With
' IMPORTANT! By Worksheet_Activate() Call AdjustWorksheet_OFF is made
' This triggers Excel to update and all Excel function RAND() will get a new value. BIG PROBLEM!
A LOT MORE OF COPYING FROM EXCEL THEN PASTING INTO WORD HAPPENS HERE!
With xlDoc
Application.Goto Reference:="KUNDPOST_A1"
End With
If Dir(Range("V_22200").Value) <> "" Then
Kill Range("V_22200").Value
End If
' Range("V_22200").Value = "C:\Documents and Settings\Rejje\Desktop\0ED467\2.docx"
' HERE'S THE PROBLEM! As Sub AdjustWorksheet_OFF has triggered update a new directory has been made and SaveAs Range("V_22200").Value cannot be found!
wrdDoc.SaveAs Range("V_22200").Value, FileFormat _
:=wdFormatXMLDocument, LockComments:=False, Password:="", _
AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
:=False, SaveAsAOCELetter:=False
wrdDoc.Close
wrdApp.Quit
Set wrdTbl = Nothing
Set wrdDoc = Nothing
Set wrdApp = Nothing
sub_exit:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Exit Sub
err_handler:
MsgBox ("An error occured - document was not created!")
Resume sub_exit
End Sub
Sub AdjustWorksheet_SJR()
Application.ScreenUpdating = False
Application.Calculation = xlManual
Range(Range("V_45300").Value).ColumnWidth = Range("V_45400").Value
Range(Range("V_49800").Value).EntireRow.Hidden = False
A LOT MORE ADJUSTMENTS OF THE WORKSHEET ARE DONE HERE!
Range("SJÄLVRISKMATRIS_A1").Select
With ActiveWindow
.ScrollRow = 1
.ScrollColumn = 1
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Sub AdjustWorksheet_OFF()
Application.ScreenUpdating = False
Application.Calculation = xlManual
Range(Range("V_54700").Value).ColumnWidth = Range("V_54800").Value
Range(Range("V_58200").Value).EntireRow.Hidden = False
End If
A LOT MORE ADJUSTMENTS OF THE WORKSHEET ARE DONE HERE!
Range("OFFERT_A1").Select
With ActiveWindow
.ScrollRow = 1
.ScrollColumn = 1
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
IMPORTANT! It is essential that both Sub AdjustWorksheet_SJR and Sub AdjustWorksheet_OFF will calculate as these affects the layout of ranges to be copied by Sub CreateWordDoc2.
IMPORTANT! I would rather not have to change any code in Sub AdjustWorksheet_SJR and Sub AdjustWorksheet_OFF as these are called for by other events as well.
What can I do? Can anyone help?
The macro CreateWordDoc2 is supposed to create 2 different Word documents. But: A big problem has occured as I have added 2 macros that makes a lot of adjustment to worksheets that includes ranges to be copied by the macro.
Well, I think I have no choise but to show a lot of vba below in order to get correct help.
Public Enum WordConstants
wdInLine = 0
wdPasteText = 2
wdPasteEnhancedMetafile = 9
End Enum
Sub CreateWordDoc2()
Dim wrdApp As Object
Dim wrdDoc As Object
Dim wrdTbl As Word.Range
Dim xlDoc As Workbook
Dim i As Integer
On Error GoTo err_handler
Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True
Set wrdDoc = wrdApp.Documents.Open("C:\Documents and Settings\Rejje\Desktop\Kundpost\DOKUMENT\V608.dotx")
Set wrdTbl = wrdDoc.Content
Set xlDoc = ActiveWorkbook
Application.ScreenUpdating = False
Application.Calculation = xlManual
With xlDoc.Worksheets
Application.Goto Reference:=Range("V_20500").Value
Selection.Copy
End With
A LOT MORE OF COPYING FROM EXCEL THEN PASTING INTO WORD HAPPENS HERE!
With xlDoc
Application.Goto Reference:=Range("V_21200").Value
Application.Goto Reference:=Range("V_21200").Value
Selection.Copy
End With
' By Worksheet_Activate() Call AdjustWorksheet_SJR is made
' This triggers Excel to update and all Excel function RAND() will get a new value. NOT A PROBLEM!
A LOT MORE OF COPYING FROM EXCEL THEN PASTING INTO WORD HAPPENS HERE!
MkDir Range("V_20200").Value
' Range("V_20200").Value = "C:\Documents and Settings\Rejje\Desktop\74BDFF"
' A folder is created with a randomized name by Excel function RAND(). This folder is supposed to contain the 2 Word documents this macro creates.
If Dir(Range("V_21700").Value) <> "" Then
Kill Range("V_21700").Value
End If
' Range("V_21700").Value = "C:\Documents and Settings\Rejje\Desktop\74BDFF\1.docx"
wrdDoc.SaveAs Range("V_21700").Value, FileFormat _
:=wdFormatXMLDocument, LockComments:=False, Password:="", _
AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
:=False, SaveAsAOCELetter:=False
Set wrdDoc = Nothing
Set wrdDoc = wrdApp.Documents.Open("C:\Documents and Settings\Rejje\Desktop\Kundpost\DOKUMENT\V660.dotx")
With wrdApp
For i = 1 To Range("V_21850").Value
.Selection.TypeParagraph
Next i
End With
A LOT MORE OF COPYING FROM EXCEL THEN PASTING INTO WORD HAPPENS HERE!
With xlDoc
Application.Goto Reference:=Range("V_22000").Value
Application.Goto Reference:=Range("V_22000").Value
Selection.Copy
End With
' IMPORTANT! By Worksheet_Activate() Call AdjustWorksheet_OFF is made
' This triggers Excel to update and all Excel function RAND() will get a new value. BIG PROBLEM!
A LOT MORE OF COPYING FROM EXCEL THEN PASTING INTO WORD HAPPENS HERE!
With xlDoc
Application.Goto Reference:="KUNDPOST_A1"
End With
If Dir(Range("V_22200").Value) <> "" Then
Kill Range("V_22200").Value
End If
' Range("V_22200").Value = "C:\Documents and Settings\Rejje\Desktop\0ED467\2.docx"
' HERE'S THE PROBLEM! As Sub AdjustWorksheet_OFF has triggered update a new directory has been made and SaveAs Range("V_22200").Value cannot be found!
wrdDoc.SaveAs Range("V_22200").Value, FileFormat _
:=wdFormatXMLDocument, LockComments:=False, Password:="", _
AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, _
EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData _
:=False, SaveAsAOCELetter:=False
wrdDoc.Close
wrdApp.Quit
Set wrdTbl = Nothing
Set wrdDoc = Nothing
Set wrdApp = Nothing
sub_exit:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Exit Sub
err_handler:
MsgBox ("An error occured - document was not created!")
Resume sub_exit
End Sub
Sub AdjustWorksheet_SJR()
Application.ScreenUpdating = False
Application.Calculation = xlManual
Range(Range("V_45300").Value).ColumnWidth = Range("V_45400").Value
Range(Range("V_49800").Value).EntireRow.Hidden = False
A LOT MORE ADJUSTMENTS OF THE WORKSHEET ARE DONE HERE!
Range("SJÄLVRISKMATRIS_A1").Select
With ActiveWindow
.ScrollRow = 1
.ScrollColumn = 1
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Sub AdjustWorksheet_OFF()
Application.ScreenUpdating = False
Application.Calculation = xlManual
Range(Range("V_54700").Value).ColumnWidth = Range("V_54800").Value
Range(Range("V_58200").Value).EntireRow.Hidden = False
End If
A LOT MORE ADJUSTMENTS OF THE WORKSHEET ARE DONE HERE!
Range("OFFERT_A1").Select
With ActiveWindow
.ScrollRow = 1
.ScrollColumn = 1
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
IMPORTANT! It is essential that both Sub AdjustWorksheet_SJR and Sub AdjustWorksheet_OFF will calculate as these affects the layout of ranges to be copied by Sub CreateWordDoc2.
IMPORTANT! I would rather not have to change any code in Sub AdjustWorksheet_SJR and Sub AdjustWorksheet_OFF as these are called for by other events as well.
What can I do? Can anyone help?