PDA

View Full Version : فراخوانی سند ورد ، ویرایش و چاپ سند!



niksalehi
سه شنبه 15 فروردین 1391, 13:11 عصر
سلام دوستان!

من به سند ورد دارم که توش چارت هایی وجود داره، میخوام اونو تو برنامم فراخوانی کنم، بعدش میخوام تو همون برنامم ادیتش کنم ( میخوام سه تا تکستباکس بسازم و متن توی تکستباکس رو با یک کلیک ببرم توی ورد، یعنی سه تا جای خالی توی ورد باشه که با کلیک روی کامند باتن، متن اون سه تا جای خالی پر بشه)
بعد هم سند رو پرینت بگیرم!
از هرکی پرسیدم نتونست جواب بده :(( کاش اینجا جواب بگیرم :قلب:

رامین مرادی
پنج شنبه 17 فروردین 1391, 18:26 عصر
دوست عزیز یه شیی بود به نام فکر کنم ران تایم .... البته دقیق یادم نمی یاد اجازه بده اگه پیدا کردم برات می دم با اون می تونستی برنامه های آفیس رو دستکاری کنی البته خود برنامه رو نه ولی امکانات افیس رو می تونستی داشته باشی
منتظر باش برات پیدا می کنم....

رامین مرادی
پنج شنبه 17 فروردین 1391, 19:41 عصر
دوست عزیز می تونی در لینک زیر که بحشی از کتاب دوم هنرستان می باشد مطالبی مربوط به کار با وورد رو یاد بگیری
http://tvoccd.medu.ir/tvoccdcomputer/tvoccdcomputerDocs/notice/barnamesazi2-_Part3.zip اینم لینک دانلود
اگه به دردت خورد تشکر یادت نره:چشمک:

rezankh
پنج شنبه 17 فروردین 1391, 19:54 عصر
سلام من از اين كد براي تنظيم صفحه، قرار دادن متن، عكسهاي بخصوص و در نهايت ذخيره ورد با نام مخصوص استفاده كردم.( البته با تشكر از راهنمايي دوستان)

Private Sub XPButton2_Click()

Dim X As Word.Application
Set X = New Word.Application
X.Visible = True
X.Documents.Add DocumentType:=0

'Selection.HasChildShapeRange
'x.ActiveDocument.PageSetup.PaperSize = wdPaperA4
'x.ActiveDocument.PageSetup.PageHeight = 29.7
'x.ActiveDocument.PageSetup.PageWidth = 21
X.ActiveDocument.PageSetup.RightMargin = 20
X.ActiveDocument.PageSetup.LeftMargin = 20
X.ActiveDocument.PageSetup.TopMargin = 20
X.ActiveDocument.PageSetup.BottomMargin = 20

Dim n1 As String
Dim n2 As String

Dim d As String
Dim y As String
Dim m As String
Dim ymd As String

d = Mid(Caltext1.Text, 9, 2)
m = Mid(Caltext1.Text, 6, 2)
y = Mid(Caltext1.Text, 1, 4)
ymd = d + "/" + m + "/" + y

Dim t0 As String
Dim t As String
t = Replace(Caltext1.Text, "/", "")
t0 = StrReverse(Caltext1.Text)
X.Selection.TypeText Text:=" " + "نام : " + "" & Text2.Text & "" + " " + "شماره پرونده: " + "" & Text3.Text & "" + " " + "تاريخ : " + "" & ymd & ""
X.Selection.TypeParagraph

Dim obj As Word.InlineShape
Dim I As Integer

Adodc2.Recordset.MoveFirst

Do While Not Adodc2.Recordset.EOF

Set obj = X.Selection.InlineShapes.AddPicture(App.Path & "" & Adodc2.Recordset.Fields("PicAdressRright1") & "")
obj.Width = 130
obj.Height = 90
obj.Line.Visible = msoTriStateToggle
'obj.Line.DashStyle = msoLineDashDotDot
'x.Selection.TypeParagraph
X.Selection.TypeText Text:=" "

Set obj = X.Selection.InlineShapes.AddPicture(App.Path & "" & Adodc2.Recordset.Fields("PicAdressLeft1") & "")
obj.Width = 130
obj.Height = 90
obj.Line.Visible = msoTrue

X.Selection.TypeText Text:=" "

'obj.Line.DashStyle = msoLineDashDotDot

'Dim obj As Word.InlineShape

On Error GoTo ErrorHandle

If Adodc2.Recordset.Fields("Nowe2") <> "" Then

Set obj = X.Selection.InlineShapes.AddPicture(App.Path & "" & Adodc2.Recordset.Fields("PicAdressRright2") & "")
obj.Width = 130
obj.Height = 90
obj.Line.Visible = msoTrue
X.Selection.TypeText Text:=" "


Set obj = X.Selection.InlineShapes.AddPicture(App.Path & "" & Adodc2.Recordset.Fields("PicAdressLeft2") & "")
obj.Width = 130
obj.Height = 90
obj.Line.Visible = msoTrue


If Adodc2.Recordset.Fields("Nowe1") = "گاو شيري" Then
n1 = Adodc2.Recordset.Fields("Nowe1") + " "
End If
If Adodc2.Recordset.Fields("Nowe1") = "تليسه آبستن" Then
n1 = Adodc2.Recordset.Fields("Nowe1") + " "
End If
If Adodc2.Recordset.Fields("Nowe1") = "گوساله 3-9ماه" Then
n1 = Adodc2.Recordset.Fields("Nowe1") + " "
End If
If Adodc2.Recordset.Fields("Nowe1") = "گوساله ماده9-15ماه" Then
n1 = Adodc2.Recordset.Fields("Nowe1") + " "
End If
If Adodc2.Recordset.Fields("Nowe1") = "گوساله نر9-15ماه" Then
n1 = Adodc2.Recordset.Fields("Nowe1") + " "
End If
If Adodc2.Recordset.Fields("Nowe1") = "جوانه" Then
n1 = Adodc2.Recordset.Fields("Nowe1") + " "
End If

If Adodc2.Recordset.Fields("Nowe2") = "گاو شيري" Then
n2 = Adodc2.Recordset.Fields("Nowe2") + " "
End If
If Adodc2.Recordset.Fields("Nowe2") = "تليسه آبستن" Then
n2 = Adodc2.Recordset.Fields("Nowe2") + " "
End If
If Adodc2.Recordset.Fields("Nowe2") = "گوساله 3-9ماه" Then
n2 = Adodc2.Recordset.Fields("Nowe2") + " "
End If
If Adodc2.Recordset.Fields("Nowe2") = "گوساله ماده9-15ماه" Then
n2 = Adodc2.Recordset.Fields("Nowe2") + " "
End If
If Adodc2.Recordset.Fields("Nowe2") = "گوساله نر9-15ماه" Then
n2 = Adodc2.Recordset.Fields("Nowe2") + " "
End If
If Adodc2.Recordset.Fields("Nowe2") = "جوانه" Then
n2 = Adodc2.Recordset.Fields("Nowe2") + " "
End If


Else


Set obj = X.Selection.InlineShapes.AddPicture(App.Path & "\white.jpg")
obj.Width = 130
obj.Height = 90
obj.Line.Visible = msoTrue
X.Selection.TypeText Text:=" "

Set obj = X.Selection.InlineShapes.AddPicture(App.Path & "\white.jpg")
obj.Width = 130
obj.Height = 90
obj.Line.Visible = msoTrue

n2 = " "

End If

ErrorHandle:
Resume Next


X.Selection.TypeText Text:=" " + "" & n1 & "" + " " + "" & Adodc2.Recordset.Fields("Plak1") & "" + " " + "" & n2 & "" + " " + "" & Adodc2.Recordset.Fields("Plak2") & "" + " "

X.Selection.TypeText Text:="------------------------------------------------------------------------------------------------------------------------------------------------------"

Adodc2.Recordset.MoveNext
Loop

Dim n As String
n = "" & Text2.Text & "" + " " + "" & t & "" + " " + "" & DataCombo2.Text & ""
MkDir App.Path & "\Pictures\" & n & ""

X.ActiveDocument.SaveAs FileName:=App.Path & "\Pictures\" & n & "\" & n & "", FileFormat:=wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:=False

MkDir App.Path & "\Pictures\" & n & "\Pictures\"

Adodc3.Recordset.MoveFirst

Do While Not Adodc3.Recordset.EOF

Name App.Path & "" & Adodc3.Recordset.Fields("PicAdressRright") & "" As App.Path & "\Pictures\" & n & "\" & Adodc3.Recordset.Fields("PicAdressRright") & ""
Name App.Path & "" & Adodc3.Recordset.Fields("PicAdressLeft") & "" As App.Path & "\Pictures\" & n & "\" & Adodc3.Recordset.Fields("PicAdressLeft") & ""
Adodc3.Recordset.MoveNext

Loop

End Sub