bucky7199
04-15-2008, 06:17 AM
Hi,
I have a word app where you can hit a browse button and browse for a file and select it and have it automatically paste into a word template after you hit submit. Problem is, it only pastes in the first page of the document. I did not write the program but I need to fix it. I am including the code that I believe pertains to the browse buttons. Thanks.
'finally actually copy from all the proper documents and paste
'to the proper locations
'the main function.
Private Sub CommandButton2_Click()
'first time the button's been clicked on
If (CommandButton2.Caption = "Enter") Then
'hide the text boxes, etc
Dim cont As control
For Each cont In UserForm1.Controls
If (TypeOf cont Is CommandButton) Or (TypeOf cont Is optionbutton) Or (TypeOf cont Is TextBox) Or (TypeOf cont Is Label) Or (TypeOf cont Is ComboBox) Or (TypeOf cont Is MSForms.checkbox) Then
cont.Visible = False
End If
Next cont
CommandButton2.Visible = True
CommandButton2.Caption = "Submit" 'change the caption of this button
Save.Visible = True 'make other things visible.
Label3.Visible = True
Label3.ZOrder (fmTop)
Initialize 'use the list file to initialize.
Else
UserForm1.Hide 'we're done, so close this window. (otherwise they might accidently click this
'button twice, and chaos would ensue.
Dim but As control
Dim num As Long
'insert objects from a browse button.
Dim counter As Integer
For counter = Global_Insert_Object_Count To 0 Step -1
If (Global_Insert_Object_File(counter) <> "") Then
'if it's a .xls...
If (InStr(Global_Insert_Object_File(counter), ".xls")) Then
Dim xls As Workbook
Dim obj As Object
Set obj = CreateObject("Excel.Application")
obj.Visible = True
Set xls = obj.Workbooks.Open(Global_Insert_Object_File(counter))
Dim ch As Worksheet
'we have to do this in reverse order, so that
'once they've all been pasted in, they end up
'in the correct order!
Dim j As Integer
For j = xls.Worksheets.Count To 1 Step -1
Set ch = xls.Worksheets(j)
If (ch.PageSetup.PrintArea <> "") Then
Dim area As Excel.Range
Set area = ch.Range(ch.PageSetup.PrintArea)
Dim number1 As Integer
number1 = 0
If area.Rows.Count > 300 Then 'it has a pagebreak
ch.Range(ch.Cells((Fix(area.Rows.Count / 2)) + 1, 1), ch.Cells(area.Rows.Count, area.Columns.Count)).CopyPicture
Global_Found = True
PasteDoc header:=Global_Insert_Object_Heading(counter)
ch.Range(ch.Cells(1, 1), ch.Cells(Fix(area.Rows.Count / 2), area.Columns.Count)).CopyPicture
Global_Found = True
PasteDoc header:=Global_Insert_Object_Heading(counter)
Else
area.CopyPicture
Global_Found = True
PasteDoc header:=Global_Insert_Object_Heading(counter)
End If
Else
'if it doesn't have a specific print area,
'dont even copy/paste it
'(that means its probably a revisions page)
Global_Found = False
End If
Next
'so that it won't ask about the large thing you just copied.
xls.Sheets(1).Range("A1").Copy
obj.Quit
Else
'if it's not an excel file, try to put it in anyway.
Dim sec As Section
For Each sec In ActiveDocument.Sections 'loop through sections
If sec.index >= 4 Then 'don't alter the first few sections (title page, table of contents,
'etc. this is done because otherwise we get false positives in the
'table of contents. kind of a cheap hack, but it works
num = InStr(sec.Range.Text, Global_Insert_Object_Heading(counter)) 'find if and
'where in the document the header name that we're looking for is.
If (num <> 0) Then 'if we found it.)
num = num + Len(Global_Insert_Object_Heading(counter)) ' the length of the string we searched for (becuase we want to paste AFTER that)
num = num + sec.Range.Start 'because our number is relative to section and we need it relative to doc
' *****************************************************
If (ActiveDocument.Content.End <= num) Then 'if we've passed the end of the document
num = ActiveDocument.Content.End - 1 'then set our location to JUST before the end (otherwise, chaos)
End If
Exit For 'no point in continuing to look for it if we already found it.
End If
End If
Next sec
If (num = 0) Then 'if the paste location was not found
MsgBox ("InsertBrowse Location '" & Global_Insert_Object_Heading(counter) & "' Not Found.")
Else 'the paste location WAS found.
Selection.Start = num 'we want to paste it at the location we found,
Selection.End = num 'so we set the selection to there (insert object will insert where the selection is)
If (InStr(Global_Insert_Object_File(counter), ".jpg")) Then
Selection.InlineShapes.AddPicture Filename:=Global_Insert_Object_File(counter)
Selection.InsertAfter (vbCrLf)
Else
With Dialogs(wdDialogInsertObject) 'using the insert object dialog
.Filename = Global_Insert_Object_File(counter) 'set the filename to what we found earlier
.iconnumber = 0 'this stuff
.link = 0 'is almost
.displayicon = 0 'definitely
.Tab = 1 'unnecessary
.iconfilename = "" 'but is kept
.Caption = Global_Insert_Object_File(counter) 'just
.floating = 0 'in case
.Execute 'this line actually inserts the object.
End With
End If
End If
End If
End If
Next
I have a word app where you can hit a browse button and browse for a file and select it and have it automatically paste into a word template after you hit submit. Problem is, it only pastes in the first page of the document. I did not write the program but I need to fix it. I am including the code that I believe pertains to the browse buttons. Thanks.
'finally actually copy from all the proper documents and paste
'to the proper locations
'the main function.
Private Sub CommandButton2_Click()
'first time the button's been clicked on
If (CommandButton2.Caption = "Enter") Then
'hide the text boxes, etc
Dim cont As control
For Each cont In UserForm1.Controls
If (TypeOf cont Is CommandButton) Or (TypeOf cont Is optionbutton) Or (TypeOf cont Is TextBox) Or (TypeOf cont Is Label) Or (TypeOf cont Is ComboBox) Or (TypeOf cont Is MSForms.checkbox) Then
cont.Visible = False
End If
Next cont
CommandButton2.Visible = True
CommandButton2.Caption = "Submit" 'change the caption of this button
Save.Visible = True 'make other things visible.
Label3.Visible = True
Label3.ZOrder (fmTop)
Initialize 'use the list file to initialize.
Else
UserForm1.Hide 'we're done, so close this window. (otherwise they might accidently click this
'button twice, and chaos would ensue.
Dim but As control
Dim num As Long
'insert objects from a browse button.
Dim counter As Integer
For counter = Global_Insert_Object_Count To 0 Step -1
If (Global_Insert_Object_File(counter) <> "") Then
'if it's a .xls...
If (InStr(Global_Insert_Object_File(counter), ".xls")) Then
Dim xls As Workbook
Dim obj As Object
Set obj = CreateObject("Excel.Application")
obj.Visible = True
Set xls = obj.Workbooks.Open(Global_Insert_Object_File(counter))
Dim ch As Worksheet
'we have to do this in reverse order, so that
'once they've all been pasted in, they end up
'in the correct order!
Dim j As Integer
For j = xls.Worksheets.Count To 1 Step -1
Set ch = xls.Worksheets(j)
If (ch.PageSetup.PrintArea <> "") Then
Dim area As Excel.Range
Set area = ch.Range(ch.PageSetup.PrintArea)
Dim number1 As Integer
number1 = 0
If area.Rows.Count > 300 Then 'it has a pagebreak
ch.Range(ch.Cells((Fix(area.Rows.Count / 2)) + 1, 1), ch.Cells(area.Rows.Count, area.Columns.Count)).CopyPicture
Global_Found = True
PasteDoc header:=Global_Insert_Object_Heading(counter)
ch.Range(ch.Cells(1, 1), ch.Cells(Fix(area.Rows.Count / 2), area.Columns.Count)).CopyPicture
Global_Found = True
PasteDoc header:=Global_Insert_Object_Heading(counter)
Else
area.CopyPicture
Global_Found = True
PasteDoc header:=Global_Insert_Object_Heading(counter)
End If
Else
'if it doesn't have a specific print area,
'dont even copy/paste it
'(that means its probably a revisions page)
Global_Found = False
End If
Next
'so that it won't ask about the large thing you just copied.
xls.Sheets(1).Range("A1").Copy
obj.Quit
Else
'if it's not an excel file, try to put it in anyway.
Dim sec As Section
For Each sec In ActiveDocument.Sections 'loop through sections
If sec.index >= 4 Then 'don't alter the first few sections (title page, table of contents,
'etc. this is done because otherwise we get false positives in the
'table of contents. kind of a cheap hack, but it works
num = InStr(sec.Range.Text, Global_Insert_Object_Heading(counter)) 'find if and
'where in the document the header name that we're looking for is.
If (num <> 0) Then 'if we found it.)
num = num + Len(Global_Insert_Object_Heading(counter)) ' the length of the string we searched for (becuase we want to paste AFTER that)
num = num + sec.Range.Start 'because our number is relative to section and we need it relative to doc
' *****************************************************
If (ActiveDocument.Content.End <= num) Then 'if we've passed the end of the document
num = ActiveDocument.Content.End - 1 'then set our location to JUST before the end (otherwise, chaos)
End If
Exit For 'no point in continuing to look for it if we already found it.
End If
End If
Next sec
If (num = 0) Then 'if the paste location was not found
MsgBox ("InsertBrowse Location '" & Global_Insert_Object_Heading(counter) & "' Not Found.")
Else 'the paste location WAS found.
Selection.Start = num 'we want to paste it at the location we found,
Selection.End = num 'so we set the selection to there (insert object will insert where the selection is)
If (InStr(Global_Insert_Object_File(counter), ".jpg")) Then
Selection.InlineShapes.AddPicture Filename:=Global_Insert_Object_File(counter)
Selection.InsertAfter (vbCrLf)
Else
With Dialogs(wdDialogInsertObject) 'using the insert object dialog
.Filename = Global_Insert_Object_File(counter) 'set the filename to what we found earlier
.iconnumber = 0 'this stuff
.link = 0 'is almost
.displayicon = 0 'definitely
.Tab = 1 'unnecessary
.iconfilename = "" 'but is kept
.Caption = Global_Insert_Object_File(counter) 'just
.floating = 0 'in case
.Execute 'this line actually inserts the object.
End With
End If
End If
End If
End If
Next