I made a software to print a specific type of labels (100x150) on a TCS Barcode Printer DA200 machine, When I print it prints on two pages disorganized, most of the text is on the first page and the rest on the second. I've tried to change almost every code but it's not working. I would like to make the print responsive and stay on just one page.
The output Code:
Sub Print()
TextBox5.Text = ""
TextBox5.AppendText("Produced By:" + vbTab + vbTab + "Company")
TextBox5.AppendText("" + vbNewLine)
TextBox5.AppendText("" + vbTab + vbTab + vbTab + "Address")
TextBox5.AppendText("" + vbNewLine)
TextBox5.AppendText("" + vbTab + vbTab + vbTab + "No. 1")
TextBox5.AppendText("" + vbNewLine)
TextBox5.AppendText("" + vbTab + vbTab + vbTab + "City")
TextBox5.AppendText("" + vbNewLine)
TextBox5.AppendText("" + vbNewLine)
TextBox5.AppendText("Product:" + vbTab + vbTab + "SPECIE")
TextBox5.AppendText("" + vbNewLine)
TextBox5.AppendText("Product Format:" + vbTab + "Fresh Skin OFF Loin")
TextBox5.AppendText("" + vbNewLine)
TextBox5.AppendText("Grade:" + vbTab + vbTab + vbTab + "GRADE")
TextBox5.AppendText("" + vbNewLine)
TextBox5.AppendText("Catch Area:" + vbTab + vbTab + "FAO 51")
TextBox5.AppendText("" + vbNewLine)
TextBox5.AppendText("Storage Instructions:" + vbTab + "0.5º to 1.5º Celcius")
TextBox5.AppendText("" + vbNewLine)
TextBox5.AppendText("Establishment No.:" + vbTab + "A22.1")
TextBox5.AppendText("" + vbNewLine)
TextBox5.AppendText("Origin:" + vbTab + vbTab + vbTab + "Origin")
TextBox5.AppendText("" + vbNewLine)
TextBox5.AppendText("Vessel Name/s:" + vbTab + vbTab + vesselcmb.SelectedItem)
TextBox5.AppendText("" + vbNewLine)
TextBox5.AppendText("" + vbNewLine)
TextBox5.AppendText("" + vbNewLine)
TextBox5.AppendText("Product Date:" + vbTab + vbTab + Date.Now.Date)
TextBox5.AppendText("" + vbNewLine)
TextBox5.AppendText("Best Before:" + vbTab + vbTab + Date.Now.Date.AddDays(16))
TextBox5.AppendText("" + vbNewLine)
TextBox5.AppendText("Project code:" + vbTab + vbTab + voyageprint.Text)
TextBox5.AppendText("" + vbNewLine)
TextBox5.AppendText("Net Weight:" + vbTab + vbTab + "")
TextBox5.AppendText("" + vbNewLine)
TextBox5.AppendText("" + vbNewLine)
TextBox5.AppendText("" + vbTab + "To be further prepared for consumption")
TextBox5.AppendText("" + vbNewLine)
TextBox5.AppendText("" + vbTab + vbTab + "100% Natural")
'' TextBox5.AppendText(vbTab + vbTab + vbTab + PictureBox1.Text + vbNewLine)
PrintPreviewDialog1.ShowDialog()
The Print Document Code:
Private Sub PrintDocument1_PrintPage(sender As Object, e As Printing.PrintPageEventArgs) Handles PrintDocument1.PrintPage
Dim printfont As New Font("Arial", 12, FontStyle.Bold)
Dim SizeP As New PaperSize("Label 100x150", 100, 150)
e.Graphics.DrawString(TextBox5.Text, printfont, Brushes.Black, 4, 6)
'' e.Graphics.DrawImage(Me.PictureBox1.Image, 120, 130, PictureBox1.Width - 15, PictureBox1.Height - 25)
End Sub
How it Prints:
Consider converting the text to image and print image to printer.
Some code you may need:
Private img As Bitmap
Private str As StringBuilder = New StringBuilder
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
str.Append("Produced By:" + vbTab + vbTab + "Company")
str.Append("" + vbNewLine)
str.Append("" + vbTab + vbTab + vbTab + "Address")
str.Append("" + vbNewLine)
str.Append("" + vbTab + vbTab + vbTab + "No. 1")
str.Append("" + vbNewLine)
str.Append("" + vbTab + vbTab + vbTab + "City")
str.Append("" + vbNewLine)
str.Append("" + vbNewLine)
str.Append("Product:" + vbTab + vbTab + "SPECIE")
str.Append("" + vbNewLine)
str.Append("Product Format:" + vbTab + "Fresh Skin OFF Loin")
str.Append("" + vbNewLine)
str.Append("Grade:" + vbTab + vbTab + vbTab + "GRADE")
str.Append("" + vbNewLine)
str.Append("Catch Area:" + vbTab + vbTab + "FAO 51")
str.Append("" + vbNewLine)
str.Append("Storage Instructions:" + vbTab + "0.5º to 1.5º Celcius")
str.Append("" + vbNewLine)
str.Append("Establishment No.:" + vbTab + "A22.1")
str.Append("" + vbNewLine)
str.Append("Origin:" + vbTab + vbTab + vbTab + "Origin")
str.Append("" + vbNewLine)
str.Append("Vessel Name/s:" + vbTab + vbTab + "vesselcmb.SelectedItem")
str.Append("" + vbNewLine)
str.Append("" + vbNewLine)
str.Append("" + vbNewLine)
str.Append("Product Date:" + vbTab + vbTab + Date.Now.Date)
str.Append("" + vbNewLine)
str.Append("Best Before:" + vbTab + vbTab + Date.Now.Date.AddDays(16))
str.Append("" + vbNewLine)
str.Append("Project code:" + vbTab + vbTab + "voyageprint.Text")
str.Append("" + vbNewLine)
str.Append("Net Weight:" + vbTab + vbTab + "")
str.Append("" + vbNewLine)
str.Append("" + vbNewLine)
str.Append("" + vbTab + "To be further prepared for consumption")
str.Append("" + vbNewLine)
str.Append("" + vbTab + vbTab + "100% Natural")
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
img = ConvertTextToImage(str.ToString, "Arial", 12, Color.White, Color.Black, 840, 1188)
Dim printDialog1 As PrintDialog = New PrintDialog()
printDialog1.Document = PrintDocument1
Dim result As DialogResult = printDialog1.ShowDialog()
If result = DialogResult.OK Then
PrintDocument1.Print()
End If
End Sub
Private Sub PrintDocument1_PrintPage(sender As Object, e As Printing.PrintPageEventArgs) Handles PrintDocument1.PrintPage
e.Graphics.DrawImage(img, e.MarginBounds)
End Sub
Public Function ConvertTextToImage(ByVal txt As String, ByVal fontname As String, ByVal fontsize As Integer, ByVal bgcolor As Color, ByVal fcolor As Color, ByVal width As Integer, ByVal Height As Integer) As Bitmap
Dim bmp As Bitmap = New Bitmap(width, Height)
Using graphics As Graphics = Graphics.FromImage(bmp)
Dim font As Font = New Font(fontname, fontsize)
graphics.FillRectangle(New SolidBrush(bgcolor), 0, 0, bmp.Width, bmp.Height)
graphics.DrawString(txt, font, New SolidBrush(fcolor), 0, 0)
graphics.Flush()
font.Dispose()
graphics.Dispose()
End Using
Return bmp
End Function
Result of my test.
Related
Im trying to send json object in Outlook using vba. Here is my code:
Dim Msg As Outlook.MeetingItem
Set Msg = Item
Set recips = Msg.Recipients
Dim regEx As New RegExp
regEx.Pattern = "^\w+\s\w+,\sI351$"
Dim URL As String
URL = "https://webhook.site/55759d1a-7892-4c20-8d15-3b8b7f1bf3b3"
For Each recip In recips
If regEx.Test(recip.AddressEntry) And recip.AddressEntry <> "Application Management Linux1, I351" Then
Dim convertedJson As Object
Set convertedJson = JsonConverter.ParseJson("{""fields"": 123}")
Set xhr = CreateObject("MSXML2.ServerXMLHTTP.6.0")
xhr.Open "POST", URL, False
xhr.setRequestHeader "Content-Type", "application/json"
xhr.Send (convertedJson)
End If
Next
If I send just plane text it works well but i can't send convertedJson. Is it possible to send an object?
UPDATE
I can't even do Debug.Print convertedJson
I was tormented by these libraries in the end I did a very terrible thing
Dim flds, prt, id, smry, descrp, issu, name, lfbrkt, rtbrkt, cma, dbdots, jsTest, issuName As String
flds = "'fields'"
prt = "'project'"
id = "'id'"
smry = "'summary'"
descrp = "'description'"
issu = "'issuetype'"
issuName = "'Improvement'"
name = "'name'"
lfbrkt = "{"
rtbrkt = "}"
cma = ","
dbdots = ":"
jsTest = lfbrkt + flds + dbdots + " " + lfbrkt + vbCrLf + vbTab + prt + dbdots + " " + lfbrkt + vbCrLf + vbTab + vbTab + id + dbdots + " " + "30611" + vbCrLf + vbTab + rtbrkt + cma + vbCrLf + vbTab + smry + dbdots + " " + "'" + CStr(Msg.Subject) + "'" + cma + vbCrLf + vbTab + descrp + dbdots + " " + "'" + CStr(Msg.Body) + "'" + cma + vbCrLf + vbTab + issu + dbdots + " " + lfbrkt + vbCrLf + vbTab + vbTab + name + dbdots + " " + issuName + vbCrLf + vbTab + rtbrkt + vbCrLf + rtbrkt + rtbrkt
And I got this
I'm trying to make excel create XML files using VBA (that my first time), so I managed to create a code but I keep getting the message that there are too many line continuations
Here is my code
Sub testXLStoXML()
sTemplateXML = _
"<?xml version='1.0'?>" + vbNewLine + _
"<offers>" + vbNewLine + _
" <offer>" + vbNewLine + _
" <offer_identifier>" + vbNewLine + _
" </offer_identifier>" + vbNewLine + _
" <offer_title>" + vbNewLine + _
" </offer_title>" + vbNewLine + _
" <offer_description>" + vbNewLine + _
" </offer_description>" + vbNewLine + _
" <offer_featured_image>" + vbNewLine + _
" </offer_featured_image>" + vbNewLine + _
" <offer_cat>" + vbNewLine + _
" </offer_cat>" + vbNewLine + _
" <offer_location>" + vbNewLine + _
" </offer_location>" + vbNewLine + _
" <offer_tags>" + vbNewLine + _
" </offer_tags>" + vbNewLine + _
" <offer_type>" + vbNewLine + _
" </offer_type>" + vbNewLine + _
" <offer_start>" + vbNewLine + _
" </offer_start>" + vbNewLine + _
" <offer_expire>" + vbNewLine + _
" </offer_expire>" + vbNewLine + _
" <offer_store>" + vbNewLine + _
" </offer_store>" + vbNewLine + _
" <!-- store -->" + vbNewLine + _
" <store_title>" + vbNewLine + _
" </store_title>" + vbNewLine + _
" <store_letter>" + vbNewLine + _
" </store_letter>" + vbNewLine + _
" <store_description>" + vbNewLine + _
" </store_description>" + vbNewLine + _
" <store_logo>" + vbNewLine + _
" </store_logo>" + vbNewLine + _
" <store_link>" + vbNewLine + _
" </store_link>" + vbNewLine + _
" <store_facebook>" + vbNewLine + _
" </store_facebook>" + vbNewLine + _
" <store_twitter>" + vbNewLine + _
" </store_twitter>" + vbNewLine + _
" <store_google>" + vbNewLine + _
" </store_google>" + vbNewLine + _
" <!-- store -->" + vbNewLine + _
" <!-- DEAL RELATED -->" + vbNewLine + _
" <deal_items>" + vbNewLine + _
" </deal_items>" + vbNewLine + _
" <deal_item_vouchers>" + vbNewLine + _
" </deal_item_vouchers>" + vbNewLine + _
" <deal_price>" + vbNewLine + _
" </deal_price>" + vbNewLine + _
" <deal_sale_price>" + vbNewLine + _
" </deal_sale_price>" + vbNewLine + _
" <deal_discount>" + vbNewLine + _
" </deal_discount>" + vbNewLine + _
" <deal_voucher_expire>" + vbNewLine + _
" </deal_voucher_expire>" + vbNewLine + _
" <deal_in_short>" + vbNewLine + _
" </deal_in_short>" + vbNewLine + _
" <deal_type>" + vbNewLine + _
" </deal_type>" + vbNewLine + _
" <deal_link>" + vbNewLine + _
" </deal_link>" + vbNewLine + _
" </offer>" + vbNewLine + _
"</offers>" + vbNewLine +
Is there a way to bypass the limit or make this work?
Per Microsoft, "There is a limit to the number of lines you can join with line-continuation characters. This error has the following cause and solution:
Your code has more than 25 physical lines lines joined with line-continuation characters, or more than 24 consecutive line-continuation characters in a single line. Make some of the constituent lines physically longer to reduce the number of line-continuation characters needed, or break the construct into more than one statement."
The line continuations are merely for ease of reading the code and are necessary to have after each tag the way you have it now
code is building the email but it is only displaying one row when there is six. I got it correct on the text file but I need it to do the same in the email message. I think I got the for next statement in the wrong location. Here is the example of the code that I am having problem with. I do not know how to place the for next statement without interrupting the vbLine
For Each p In query
If p.Contract_No IsNot Nothing Then
ContractNo = p.Contract_No
Else
ContractNo = " "
End If
If p.Vendor_Name IsNot Nothing Then
VenderName = p.Vendor_Name
Else
VenderName = " "
End If
If p.Termination_Date IsNot Nothing Then
TerminationDate = p.Termination_Date
' ReportDateStr = ReportDate.ToString
TerminationDateStr = String.Format("{0:MM/dd/yyyy}", TerminationDate)
Else
TerminationDateStr = " "
End If
If p.Dept_Name IsNot Nothing Then
DeptName = p.Dept_Name
Else
DeptName = " "
End If
If p.Renewal_Option_Desc IsNot Nothing Then
RenewalOption = p.Renewal_Option_Desc
Else
RenewalOption = " "
End If
If p.Contract_Desc IsNot Nothing Then
ContractDesc = p.Contract_Desc
Else
ContractDesc = " "
End If
If p.Contact_Email IsNot Nothing Then
ContactEmail = p.Contact_Email
Else
ContactEmail = "** N/A ** "
End If
' sends email with attachment
EmailMsgBody = "-- TOTAL # OF CONTRACTS WITH FAILSAFE DATE ON " + DateStr + " IS: " + icnt.ToString + vbCrLf +
vbNewLine + " __________________ " +
vbNewLine +
vbNewLine + " *****Contracts**** " +
vbNewLine + " __________________ " +
vbNewLine +
vbNewLine + "Contract#" + " " + "Vender Name" + " " + "Termination Date" + " " + "Dept Name" + " " + "Renewal Option" + " " + "Contract Desc" + " " + "Email Address" +
vbNewLine + "------------" + " " + "-----------------" + " " + "---------------------" + " " + "--------------" + " " + "--------------------" + " " + "-----------------" + " " + "-----------------" +
vbNewLine + ContractNo.PadRight(18) + " " + _
VenderName.PadRight(38) + " " + _
TerminationDateStr.PadRight(26) + " " + _
DeptName.PadRight(27) + " " + _
RenewalOption.PadRight(45) + " " + _
ContractDesc.PadRight(32) + " " + _
ContactEmail.PadRight(11) + " "
I'm trying to iterate through two listboxes and adding all the items to one list.
Here's my code so far but I can't seem to integrate the second listbox into it.
Dim List As List(Of String) = New List(Of String)
For Each LB1 As String In Listbox1.Items
List.Add(vbTab + vbTab + "ent = maps\mp\_utility::createOneshotEffect(" + """" + LB1.ToString() + """" + ");" + vbCrLf +
vbTab + vbTab + "ent.v[ " + """" + "origin" + """" + " ] = ( " + LB2.ToString() + " );"
Next
As long as LB1 and LB2 both contain the same number of items and both are ordered the same, you could use an indexed loop (instead of a foreach loop):
Dim List As List(Of String) = New List(Of String)
For x as integer = 0 to Listbox1.Items.count - 1
List.Add(vbTab + vbTab + "ent = maps\mp\_utility::createOneshotEffect(""" + _
ListBox1.Items(x).ToString() + """);" + vbCrLf + _
vbTab + vbTab + "ent.v[ ""origin"" ] = ( " + _
ListBox2.Items(x).ToString() + " );" _
)
Next
Im trying to get a file to be created and named when a button is pressed. But I need the file name to contain text from a textbox.
Code:
My.Computer.FileSystem.WriteAllText("c:\temp\" + txtUser.Text + ".txt", "[" + TimeOfDay + "]" + "Email: " + txtEmail.Text + vbNewLine + "Username: " + txtUser.Text + vbNewLine + "Password: " + txtPass.Text + vbNewLine + "Secuirty: " + txtSecuirty.Text + vbNewLine + vbNewLine, True)
Simple Code:
My.Computer.FileSystem.WriteAllText("c:\temp\" + txtUser.Text + ".txt", {loads of stuff}, True)
I have loads of if functions, to stop the disallowed characters.
The error I am getting is:
Expression does not produce a value
Try to see if this will work for you.
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
My.Computer.FileSystem.WriteAllText("c:\temp\" + txtUser.Text.ToString() + ".txt", "test message", True)
End Sub
Or you can change your code to
Dim strFileText As String = ""
strFileText =
"[" & TimeOfDay.ToString() & "] " & vbCrLf &
"Email: " & txtEmail.Text.ToString() & vbCrLf &
"Username: " & txtUser.Text.ToString() & vbCrLf &
"Password: " & txtPass.Text.ToString() & vbCrLf &
"Security: " & txtSecurity.Text.ToString() & vbCrLf & vbCrLf
My.Computer.FileSystem.WriteAllText("c:\temp\" + txtUser.Text.ToString() + ".txt", strFileText, True)