亖呉?盀
请用VB循环语句打印出如下图形：
Sub Form1_Click()Dim i As Integer, m As Integer, n As IntegerDim Strm As String, Strn As StringFor i = 1 To 6Strm = ＂＂For m = 1 To iStrn = ＂＂For n = 1 To mStrn = Strn & nNextIf i Mod 2 = 1 ThenStrm = Strm & ＂ ＂ & Strn & ＂ ＂ElseStrm = Strm & (-1) * Strn & ＂ ＂End IfNextPrint StrmNextEnd Sub
如何把VB中TEXT数据输出到word模板中的指定位置
展开全部 要把下列内容复制到写字板中，另存为SetWord.cls文件，然后在把它添加到工程中，就可以使用了。
VERSION 1.0 CLASSBEGINMultiUse = -1 'TruePersistable = 0 'NotPersistableDataBindingBehavior = 0 'vbNoneDataSourceBehavior = 0 'vbNoneMTSTransactionMode = 0 'NotAnMTSObjectENDAttribute VB_Name = ＂SetWord＂Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = TrueAttribute VB_PredeclaredId = FalseAttribute VB_Exposed = FalsePrivate mywdapp As Word.ApplicationPrivate mysel As Object'属性值的模块变量Private C_TemplateDoc As StringPrivate C_newDoc As StringPrivate C_PicFile As StringPrivate C_ErrMsg As IntegerPublic Event HaveError()Attribute HaveError.VB_Description = ＂出错时激发此事件.出错代码为ErrMsg属性＂'***************************************************************'ErrMsg代码：1-word没有安装 2 - 缺少参数 3 - 没权限写文件' 4 - 文件不存在''***************************************************************Public Function ReplacePic(FindStr As String, Optional Time As Integer = 0) As IntegerAttribute ReplacePic.VB_Description = ＂查找FindStr，并替换为PicFile所指向的图片文件，替换次数由time参数确定，为0时，替换所有＂'********************************************************************************' 从Word.Range对象mysel中查找所有FindStr，并替换为PicFile图像' 替换次数由time参数确定，为0时，替换所有'********************************************************************************If Len(C_PicFile) = 0 ThenC_ErrMsg = 2Exit FunctionEnd IfDim i As IntegerDim findtxt As Booleanmysel.Find.ClearFormattingmysel.Find.Replacement.ClearFormattingWith mysel.Find.Text = FindStr.Replacement.Text = ＂＂.Forward = True.Wrap = wdFindContinue.Format = False.MatchCase = False.MatchWholeWord = False.MatchByte = True.MatchWildcards = False.MatchSoundsLike = False.MatchAllWordForms = FalseEnd Withmysel.HomeKey Unit:=wdStoryfindtxt = mysel.Find.Execute(Replace:=True)If Not findtxt ThenReplacePic = 0Exit FunctionEnd Ifi = 1Do While findtxtmysel.InlineShapes.AddPicture FileName:=C_PicFileIf i = Time Then Exit Doi = i + 1mysel.HomeKey Unit:=wdStoryfindtxt = mysel.Find.Execute(Replace:=True)LoopReplacePic = iEnd FunctionPublic Function FindThis(FindStr As String) As BooleanAttribute FindThis.VB_Description = ＂查找FindStr，如果模板中有FindStr则返回True＂
vb 怎么用for循环输出 * ** *** 求大神
使用“Office批量打印精灵”可以满足你的需求，可以批量打印Word、Excel、PDF文档。
使用教程：http://jingyan.baidu.com/article/f00622280e4dd4fbd3f0c80e.html需注意，2.5版或3.0注册版才能满足你的需求，注册版才能设置打印范围，例如打印第一页或其中任意几页。
可到其官网了解详情：http://www.yiyunsoftware.com/
vb如何进行word页面设置的代码
'工程引用 Microsoft Word 12.o Objedt Library Private Sub Command1_Click()Dim wd As New Word.Applicationwd.Documents.Add DocumentType:=wdNewBlankDocumentWith wd.Selection.Font.Spacing = 2.ParagraphFormat.Alignment = wdAlignParagraphCenter '居中.Font.Size = 16 '字号.Font.Name = ＂宋体＂.Font.Bold = True '粗体.TypeText ＂这是一个VB编辑word的测试。
＂ '输出字符.Font.Bold = False.TopMargin = CentimetersToPoints(1.27) '页面上边距.BottomMargin = CentimetersToPoints(1.27) '页面下边距.LeftMargin = CentimetersToPoints(1.27) '页面左边距.RightMargin = CentimetersToPoints(1.27) '页面右边距End Withwd.Visible = Truewd.ShowMeSet wd = NothingEnd Sub
你曾今碰到“用VB实现一个打印WORD文档功能。
。
。
”这个问题...
VB.NET(2005)中打印WORD文档（.doc）有两种方法可以完成，无论哪一种，你都得安装office，呵呵。
Imports Microsoft.Office.CoreImports Word = Microsoft.Office.Interop.Word第一种，允许用户更换打印机等设置，这是很重要的。
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click PrintDialog1.AllowCurrentPage = False '不打印当前页 PrintDialog1.AllowSelection = False '不允许打印部分页等 PrintDialog1.AllowSomePages = False If PrintDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then Dim poApp As Word.Application Dim poDoc As Word.Document poApp = New Word.Application poApp.Visible = False poApp.DisplayAlerts = Word.WdAlertLevel.wdAlertsNone poDoc = poApp.Documents.Open(＂d:\1.doc＂)poApp.WordBasic.FilePrintSetup(Printer:=PrintDialog1.PrinterSettings.PrinterName, DoNotSetAsSysDefault:=1) 'DoNotSetAsSysDefault:=0就会修改默认打印机 ''poApp.ActivePrinter = PrintDialog1.PrinterSettings.PrinterName poApp.PrintOut()poDoc.Close(Word.WdSaveOptions.wdDoNotSaveChanges) 'clean up poDoc = Nothing 'close word这里有个极其重要的参数WdSaveOptions，它有三个值：wdDoNotSaveChanges、wdDoNotSaveChanges和wdPromptToSaveChanges。
当选择wdDoNotSaveChanges时，文档就会来不及输出到打印机而关闭，当选择wdPromptToSaveChanges时，word程序有时就会无法退出！poApp.Quit（)语句也是不可取的，因为默认的是wdPromptToSaveChanges。
poApp.Quit(Word.WdSaveOptions.wdPromptToSaveChanges) poApp = Nothing End If End Sub第二种，是调用windows打开的方式，很快，但是不幸的是不能更换打印机。
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click Dim MyProcess As New Process MyProcess.StartInfo.CreateNoWindow = False MyProcess.StartInfo.Verb = ＂print＂ MyProcess.StartInfo.FileName = ＂d:\1.doc＂ MyProcess.Start() MyProcess.WaitForExit(10000) MyProcess.CloseMainWindow() MyProcess.Close() End Sub***********************VB6下使用的方法：Private Sub Form_Load()Set Word1 = CreateObject(＂word.application＂)Word1.Documents.Open App.Path & ＂\1.doc＂Word1.Visible = TrueWord1.PrintOutWord1.Application.QuitEnd Sub
vb调用excel模板进行打印
Sub outputExcel() On Error GoTo merr Dim a As Object Set a = CreateObject(＂Excel.Application＂) a.visible = True Dim w As Object Set w = a.Worksheets(＂sheet1＂) Dim s() As String Dim ns As Integer ns = 10 ReDim s(ns - 1) Dim col As Integer Dim f As Field, title As String Dim tmp1 As Variant, tmp2 As Variant Dim fieldName As String With de1.rsselTmpReport If .RecordCount > 0 Then col = 0 de1.rsexcel.MoveFirst Do While Not de1.rsexcel.EOF If de1.rsexcel.Fields(＂isprint＂).Value Then If LANG = 0 Then title = de1.rsexcel.Fields(＂title＂).Value Else title = de1.rsexcel.Fields(＂title_en＂).Value End If col = col + 1 w.Cells(Count + 3, col).Value = title w.Cells(Count + 3, col).HorizontalAlignment = -4108 w.Cells(Count + 3, col).VerticalAlignment = -4108 End If de1.rsexcel.MoveNext Loop w.range(＂A1:＂ + IntToLetter(col - 1) + ＂1＂).Select a.Selection.Merge .MoveFirst While Not .EOF col = 0 de1.rsexcel.MoveFirst Do While Not de1.rsexcel.EOF If de1.rsexcel.Fields(＂isprint＂).Value Then title = de1.rsexcel.Fields(＂title＂).Value col = col + 1 If de1.rsexcel.Fields(＂fieldname＂).Value = ＂crsd＂ Then 'maybe str , val() If Not IsNull(.Fields(＂cstd＂)) Then tmp1 = myFieldValue(.Fields(＂cstd＂)) tmp1 = Val(tmp1) tmp2 = myFieldValue(.Fields(＂c＂)) tmp2 = Val(tmp2) w.Cells(Count + 4, col).Value = myDiv(tmp1, tmp2) End If ElseIf de1.rsexcel.Fields(＂fieldname＂).Value = ＂srsd＂ Then If Not IsNull(.Fields(＂sstd＂)) Then tmp1 = myFieldValue(.Fields(＂sstd＂)) tmp1 = Val(tmp1) tmp2 = myFieldValue(.Fields(＂s＂)) tmp2 = Val(tmp2) w.Cells(Count + 4, col).Value = myDiv(tmp1, tmp2) End If Else fieldName = de1.rsexcel.Fields(＂fieldname＂).Value tmp1 = myFieldValue(.Fields(fieldName)) w.Cells(Count + 4, col).Value = tmp1 End If w.Cells(Count + 4, col).HorizontalAlignment = -4108 w.Cells(Count + 4, col).VerticalAlignment = -4108 Select Case de1.rsexcel.Fields(＂fieldname＂).Value Case ＂c＂, ＂s＂, ＂cstd＂, ＂sstd＂, ＂weight＂: w.Cells(Count + 4, col).NumberFormat = ＂0.0000＂ Case ＂crsd＂, ＂srsd＂ w.Cells(Count + 4, col).NumberFormat = ＂0.0%＂ End Select End If de1.rsexcel.MoveNext Loop Count = Count + 1 .MoveNext Wend End If End With w.range(＂A3:＂ + IntToLetter(col - 1) + CStr(Count + 4 - 1)).Select a.Selection.Borders(7).LineStyle = 1 a.Selection.Borders(7).weight = 2 a.Selection.Borders(7).ColorIndex = -4105 a.Selection.Borders(8).LineStyle = 1 a.Selection.Borders(8).weight = 2 a.Selection.Borders(8).ColorIndex = -4105 a.Selection.Borders(9).LineStyle = 1 a.Selection.Borders(9).weight = 2 a.Selection.Borders(9).ColorIndex = -4105 a.Selection.Borders(10).LineStyle = 1 a.Selection.Borders(10).weight = 2 a.Selection.Borders(10).ColorIndex = -4105 a.Selection.Borders(11).LineStyle = 1 a.Selection.Borders(11).weight = 2 a.Selection.Borders(11).ColorIndex = -4105 a.Selection.Borders(12).LineStyle = 1 a.Selection.Borders(12).weight = 2 a.Selection.Borders(12).ColorIndex = -4105 w.Cells.Select a.Selection.Columns.AutoFit Exit Sub merr: saveerrmsg End Sub从我的程序中截取的部分代码供你参考。
转载请注明出处51数据库 » vb循环打印word模板
