I tried to place 2 chart next to each other with .left when it creats but i dosent work. what have i miss?
With ThisWorkbook.Worksheets("Diagram").ChartObjects.Add(200, 200, 600, 400).Chart
.Parent.Name = Name
.left = 400
If Not .HasTitle Then
.HasTitle = True
.ChartTitle.Text = Name
End If
.ChartType = xlXYScatterSmoothNoMarkers
.Axes(xlValue).CrossesAt = CrossAt
.Axes(xlCategory).TickLabels.NumberFormat = "YYYY-MM-DD"
For i = LBound(sXRanges) To UBound(sXRanges)
With .SeriesCollection.NewSeries
.Name = country(i)
.XValues = sXRanges(i)
.Values = sYRanges(i)
End With
Next
End With
.Left isn't a property of the Chart you are referencing.
What you actually want to use is the ChartObject .Parent.Left
Related
We have 4 Html pages that we are joining together into 1 file.
For the first page, we are reading a blank PDF file (letter head) to add as the background and then add the further 3 pages.
However, all seemed ok in version 8, but now the second page will not show.
thedoc reads the blank pdf and then the html page which overlays the text no issue here.
thedoc1 is the second page which will not load
thedoc1a and thedoc2 load ok.
If I remove the adding of the letter head from thedoc, then all 4 pages load ok, but as soon as I try and use the letter head, the second page doesnt load.
Ive added my script below. What I am doing wrong please
Sub page_load()
Dim rs
Dim strSQLQuery As String
Dim theDoc As Doc = New Doc()
Dim theDoc1 As Doc = New Doc()
Dim theDoc1a As Doc = New Doc()
Dim theDoc2 As Doc = New Doc()
Dim theDoccontents As Doc = New Doc()
theDoc.MediaBox.String = "A4"
theDoc1.MediaBox.String = "A4"
theDoc1a.MediaBox.String = "A4"
theDoc2.MediaBox.String = "A4
theDoc.HtmlOptions.PageCacheEnabled = False
theDoc.HtmlOptions.PageCacheClear()
theDoc.HtmlOptions.ImageQuality = 33
theDoc1.HtmlOptions.ImageQuality = 33
theDoc1a.HtmlOptions.ImageQuality = 33
theDoc2.HtmlOptions.ImageQuality = 33
theDoc.HtmlOptions.AddLinks = True
theDoc1.HtmlOptions.AddLinks = True
theDoc1a.HtmlOptions.AddLinks = True
theDoc2.HtmlOptions.AddLinks = True
theDoc.HtmlOptions.Timeout = 10000000
theDoc1.HtmlOptions.Timeout = 10000000
theDoc1a.HtmlOptions.Timeout = 10000000
theDoc2.HtmlOptions.Timeout = 10000000
Dim rbrandchosen As String
Dim quotenumber As String
Dim rnum As String
Dim cover as string
dim pagex as integer
quotenumber=request("quotenumber")
rbrandchosen=request("rbrandchosen")
response.write(quotenumber)
Dim theURL As String
Dim theID As Integer
Dim strsql as string
Dim theSection as string
Dim theCountDoc1a As Integer
Randomize()
rnum = (CInt(Math.Floor(90 * Rnd())) + 10).ToString
' add covering letter
cover = "c:\\inetpub\\wwwroot\\icopalukintranet\\pnf\\letterhead.pdf"
theDoc.Read(cover)
'theID = theDoc.AddObject("<< >>")
theDoc.HtmlOptions.UseScript = True
theDoc.HtmlOptions.Engine = EngineType.Chrome86
' Render after 2 seconds
theDoc.Rect.SetRect(20, 110, 600, 620)
theDoc.HtmlOptions.OnLoadScript = "(function(){ window.ABCpdf_go = false; setTimeout(function(){ window.ABCpdf_go = true; }, 3000); })();"
theURL = "http://localhost/icopalukintranet/pnf/rooflights/rooflightquotepdfletter.asp?quotenumber="+ quotenumber + "&stridrnd="+rnum
'theDoc.AddImageUrl(theURL)
theID = theDoc.AddImageUrl(theURL)
While True
If Not theDoc.Chainable(theID) Then
Exit While
End If
theDoc.Page = theDoc.AddPage()
theID = theDoc.AddImageToChain(theID)
End While
' add quote
theDoc1.HtmlOptions.Engine = EngineType.Chrome86
theDoc1.HtmlOptions.UseScript = True
theDoc1.Rect.SetRect(0, 0, 600, 820)
' Render after 2 seconds
theDoc1.HtmlOptions.OnLoadScript = "(function(){ window.ABCpdf_go = false; setTimeout(function(){ window.ABCpdf_go = true; }, 2000); })();"
theURL = "http://localhost/icopalukintranet/pnf/rooflights/rooflightquotepdfquote.asp?quotenumber="+ quotenumber + "&stridrnd="+rnum
theDoc1.Page = theDoc1.AddPage()
theID = theDoc1.AddImageUrl(theURL)
While True
If Not theDoc1.Chainable(theID) Then
Exit While
End If
theSection = "Quote"
theDoc1.Page = theDoc1.AddPage()
theID = theDoc1.AddImageToChain(theID)
theDoc1.AddBookmark(theSection, True)
End While
' add notes
theDoc1a.HtmlOptions.Engine = EngineType.Chrome86
theDoc1a.HtmlOptions.UseScript = True
theDoc1a.Rect.SetRect(0, 0, 600, 820)
' Render after 3 seconds
theDoc1a.HtmlOptions.OnLoadScript = "(function(){ window.ABCpdf_go = false; setTimeout(function(){ window.ABCpdf_go = true; }, 1000); })();"
theURL = "http://localhost/icopalukintranet/pnf/rooflights/rooflightquotepdfnotes.asp?quotenumber="+ quotenumber + "&stridrnd="+rnum
theDoc1a.Page = theDoc1a.AddPage()
theID = theDoc1a.AddImageUrl(theURL)
While True
If Not theDoc1a.Chainable(theID) Then
Exit While
End If
theDoc1a.Page = theDoc1a.AddPage()
theID = theDoc1a.AddImageToChain(theID)
End While
' add terms details
theDoc2.HtmlOptions.Engine = EngineType.Chrome86
theDoc2.HtmlOptions.UseScript = True
theDoc2.Rect.SetRect(20, 80, 560, 710)
theDoc2.Transform.Magnify(0.93 ,0.93, 0, 690)
' Render after 1 seconds
theDoc2.HtmlOptions.OnLoadScript = "(function(){ window.ABCpdf_go = false; setTimeout(function(){ window.ABCpdf_go = true; }, 2000); })();"
theURL = "http://localhost/icopalukintranet/pnf/rooflights/rooflightquotepdfterms.asp?quotenumber="+ quotenumber + "&stridrnd="+rnum
theDoc2.Page = theDoc2.AddPage()
theID = theDoc2.AddImageUrl(theURL)
While True
If Not theDoc2.Chainable(theID) Then
Exit While
End If
theSection = "Terms"
theDoc2.Page = theDoc2.AddPage()
theID = theDoc2.AddImageToChain(theID)
theDoc2.AddBookmark(theSection, True)
End While
Dim cst = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Server.MapPath("rooflightquotes.mdb")
Dim conn = CreateObject("ADODB.Connection")
conn.open(cst)
Session("myConn") = conn
dim rsAddquestion = Server.CreateObject("ADODB.Recordset")
strsql ="select * from pdfs where id=" & quotenumber & " "
rsAddquestion.Open(strsql, conn, 3, 3)
dim n as string
n=rsAddquestion.recordcount
rsAddquestion.AddNew
n=n+1
rsAddquestion("id")=quotenumber
rsAddquestion("pdfname") =quotenumber +"-rev"+n+".pdf"
rsAddquestion("printdate")=now()
rsAddquestion("status")="Printed"
rsAddquestion.update
rsAddquestion = Server.CreateObject("ADODB.Recordset")
strsql ="select * from header where id=" & quotenumber & " "
rsAddquestion.Open(strsql, conn, 3, 3)
rsAddquestion("status")="Printed"
rsAddquestion.update
conn.close
' add the pdf together in selected order
theDoc.Append(theDoc1)
theDoc.Append(theDoc1a)
theDoc.Append(theDoc2)
Dim theCount = theDoc.PageCount
' left bottom width heght
theDoc.Rect.String = "10 10 580 25"
theDoc.HPos = 1.0
theDoc.VPos = 0.5
theDoc.Color.String = "255 255 255"
theDoc.Font = theDoc.AddFont("Arial")
theDoc.FontSize = 10
For i = 1 To theCount
theDoc.PageNumber = i
If i <> 1 Then
theDoc.AddHtml(" Page " + i.ToString() + " of " + theCount.ToString() + "")
theDoc.FrameRect()
End If
Next
dim pdffilenamec = "pdf/"+quotenumber+"-rev"+n+".pdf"
theDoc.Save(Server.MapPath(pdffilenamec))
'response.redirect("rooflightquotepdfmenu.asp?quotenumber="+quotenumber)
End Sub
This used to work find in version 8, but not now using version 12
I have a label that the caption property does not change when written to.
The label caption stays with the text condition on program start.
The BackColor changes properly.
txtBlower.LinkTopic = strTopic 'get F/A Blower Status
txtBlower.LinkItem = "N7:12"
txtBlower.LinkMode = 1
If txtBlower.Text = "1" Then
lblBlower.BackColor = vbGreen
lblBlower.Caption = "BLOWER ON"
End If
If txtBlower.Text = "0" Then
lblBlower.BackColor = vbRed
lblBlower.Caption = "BLOWER OFF"
End If
The following is also in the program and works just fine.
txtWinter.LinkTopic = strTopic 'get Winter bit
txtWinter.LinkItem = "N7:19"
txtWinter.LinkMode = 1
If txtWinter.Text = "1" Then
lblWinter.BackColor = vbBlue
lblWinter.Caption = " WINTER"
Else:
lblWinter.BackColor = vbYellow
lblWinter.Caption = " SUMMER"
End If
I can't find any differences in the properties of the text boxes or the labels.
I am trying to write a piece of code so when the user clicks "yes" on my message box my yes.gif opens in IE, but if the user clicks "no" I want my no.gif to open in IE. I get a synax error on line 5 (Else statement).
My code:
Result = MsgBox("Text", 20, "Title")
If Result = vbYes Then Set objExplorer = CreateObject("InternetExplorer.Application")
Else Result = vbNo Then Set objExplorer1 = CreateObject("InternetExplorer.Application")
With objExplorer
.Navigate "about:blank"
.Visible = 1
.Document.Title = "Right Decision"
.Toolbar = False
.Statusbar = False
.Top = 500
.Left = 500
.Height = 400
.Width = 600
.Document.Body.InnerHTML = "<img src='C:\User\yes.gif'>"
End With
With objExplorer1
.Navigate "about:blank"
.Visible = 1
.Document.Title = "Wrong Decision"
.Toolbar = False
.Statusbar = False
.Top = 500
.Left = 500
.Height = 400
.Width = 600
.Document.Body.InnerHTML = "<img src='C:\User\no.gif'>"
End With
There are multiple issues with your code:
The only possible values from the MsgBox are vbYes and vbNo because you launched it with the vbYesNo flag. Since the result is binary there is no need for multiple comparisons (which don't work like that in VBScript anyway).
Your If statement uses the single-line If..Then form, meaning that the subsequent Else is invalid. And even if it weren't invalid the syntax would still be incorrect.
Starting different IE instances is pointless when a string and an image name are the only differences.
Your code tries to configure both instances, but one of them will be invalid regardless of the user's choice.
Use an If..Then..Else to define the settings that actually differ, then create the IE instance after the conditional and configure it accordingly.
Result = MsgBox("Text", vbYesNo + vbCritical, "Title")
If Result = vbyes Then
title = "Right Decision"
picture = "C:\User\yes.gif"
Else
title = "Wrong Decision"
picture = "C:\User\no.gif"
End If
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Navigate "about:blank"
.Visible = True
.Document.Title = title
.Toolbar = False
.Statusbar = False
.Top = 500
.Left = 500
.Height = 400
.Width = 600
.Document.Body.InnerHtml = "<img src='" & picture & "'>"
End With
i would like create a rectangle in a different picture.
For example: the code is inside testpicture, but i would like that this rect is create in testpicture2.
How is possible please ?
Thank you very much
The solution...
Private Sub GenerateRuntimeForm()
Dim ctrl As Control
Set frm = New Form1
Set cmdOK = Nothing
Set cmdCancel = Nothing
Set txtInput = Nothing
Set lblDisplay = Nothing
'clear the form
For Each ctrl In frm
ctrl.Visible = False
Next
Set cmdOK = frm.Controls.Add("VB.CommandButton", "cmdOK")
Set cmdCancel = frm.Controls.Add("VB.CommandButton", "cmdCancel")
Set txtInput = frm.Controls.Add("VB.TextBox", "txtInput")
Set lblDisplay = frm.Controls.Add("VB.Label", "lblDisplay")
With frm
'Set form's width and height
.Width = 4000
.Height = 2500
.Caption = "Run-Time Generated Form"
End With
'Setup rest of controls
With lblDisplay
.Top = 250
.Left = 250
.AutoSize = True
.FontBold = True
.Caption = IIf(allowNumericOnly, "Enter Your Age:", "Enter Your Last Name:")
End With
With txtInput
.Top = lblDisplay.Top + lblDisplay.Height + 250
.Left = 250
.Height = 295
If allowNumericOnly Then
.Width = 500
.MaxLength = 3
Else
.Width = 2500
End If
End With
With cmdOK
.Top = txtInput.Top + txtInput.Height + 375
.Width = 800
.Left = 1000
.Height = cmdGenerate(0).Height
cmdOK.Caption = "&OK"
.Enabled = False
End With
With cmdCancel
.Left = cmdOK.Left + cmdOK.Width + 100
.Top = cmdOK.Top
.Width = cmdOK.Width
.Height = cmdOK.Height
.Caption = "&Cancel"
End With
cmdOK.Visible = True
cmdCancel.Visible = True
lblDisplay.Visible = True
txtInput.Visible = True
frm.Show vbModal
End Sub
I have below macro.
Could you please modify it in such ways that it will show slide number on the top and also extract notes page.
I tried all ways but couldn't get answer-:
Sub WriteToWord()
Dim aSlide As Slide, MyDoc As New Word.Document, MyRange As Word.Range
Dim aTable As Table, aShape As Shape, TablesCount As Integer, ShapesCount As Integer
Dim i As Word.Paragraph
On Error Resume Next
With MyDoc
.Application.Visible = False
.Application.ScreenUpdating = False
For Each aSlide In ActivePresentation.Slides
For Each aShape In aSlide.Shapes
Set MyRange = .Range(.Content.End - 1, .Content.End - 1)
Select Case aShape.Type
Case msoAutoShape, msoPlaceholder, msoTextBox
If aShape.TextFrame.HasText Then
aShape.TextFrame.TextRange.Copy
MyRange.Paste
With MyRange
.ParagraphFormat.Alignment = wdAlignParagraphLeft
For Each i In MyRange.Paragraphs
If i.Range.Font.Size >= 16 Then
i.Range.Font.Size = 14
Else
i.Range.Font.Size = 12
End If
Next
End With
End If
Case msoPicture
aShape.Copy
MyRange.PasteSpecial DataType:=wdPasteMetafilePicture
ShapesCount = .Shapes.Count
With .Shapes(ShapesCount)
.LockAspectRatio = msoFalse
.Width = Word.CentimetersToPoints(14)
.Height = Word.CentimetersToPoints(6)
.Left = wdShapeCenter
.ConvertToInlineShape
End With
.Content.InsertAfter Chr(13)
Case msoEmbeddedOLEObject, msoLinkedOLEObject, msoLinkedPicture, msoOLEControlObject
aShape.Copy
MyRange.PasteSpecial DataType:=wdPasteOLEObject
ShapesCount = .Shapes.Count
With .Shapes(ShapesCount)
.LockAspectRatio = msoFalse
.Width = Word.CentimetersToPoints(14)
.Height = Word.CentimetersToPoints(6)
.Left = wdShapeCenter
.ConvertToInlineShape
End With
.Content.InsertAfter Chr(13)
Case msoTable
aShape.Copy
MyRange.Paste
TablesCount = .Tables.Count
With .Tables(TablesCount)
.PreferredWidthType = wdPreferredWidthPercent
.PreferredWidth = 100
.Range.Font.Size = 11
End With
.Content.InsertAfter Chr(13)
End Select
Next
If aSlide.SlideIndex < ActivePresentation.Slides.Count Then .Content.InsertAfter Chr(12)
.UndoClear ' Clear used memory
Next
' Change white font to black color
With .Content.Find
.ClearFormatting
.Format = True
.Font.Color = wdColorWhite
.Replacement.Font.Color = wdColorAutomatic
.Execute Replace:=wdReplaceAll
End With
MsgBox "PPT Converted to WORD completed, Please check and save document", vbInformation + vbOKOnly, "ExcelHome/ShouRou"
.Application.Visible = True
.Application.ScreenUpdating = True
End With
End Sub
Sub Auto_Open() ' Add PPTtoWord to Tool Bar when Powerpoint start
Dim MyControl As CommandBarControl
On Error Resume Next
Application.CommandBars("Standard").Controls("PPTtoWord").Delete
Set MyControl = Application.CommandBars("Standard").Controls.Add(Before:=1)
With MyControl
.Caption = "PPTtoWord"
.FaceId = 567 ' Word Icon
.Enabled = True
.Visible = True
.Width = 100
.OnAction = "WriteToWord"
.Style = msoButtonIconAndCaption
End With
End Sub
Sub Auto_Close() ' Delete PPTtoWord from Tool Bar when Powerpoint close
On Error Resume Next
Application.CommandBars("Standard").Controls("PPTtoWord").Delete
End Sub
You are running this from Word and automating PowerPoint using early binding, you need to fully qualify any PowerPoint reference.
Have you added a reference to PowerPoint library.
Change to aShape As PowerPoint.Shape
Grab the reference to the running instance of PowerPoint. PowerPoint is single instance multi-use so you can use this.
Dim PPT as PowerPoint.Application
Set PPT = CreateObject("PowerPoint.Application")
Fully qualify all references to ActivePresentation with PPT.ActivePresentation
Your macro should run then and generate something so that you can continue debugging.