I not a good code write
It will take ages to learn and write this for me
check out this code
Code:
' this is here so that the button code and the copy data code
' can both access the sheet object
Dim zzSheet As Worksheet
Private Sub btnCreateSheets_Click()
' example of looping through the ZZ sheet to create a sheet for each column
Dim invoiceSheet As Worksheet
Dim invoiceTemplateRange As Range
Dim zzSheetColumnCount As Integer
Dim zzSheetCol As Long
' assign ZZ sheet to a variable
Set zzSheet = ThisWorkbook.Sheets("ZZ")
zzSheetColumnCount = zzSheet.UsedRange.Columns.Count
' the D sheet is already available and contains the template for the invoice
Set invoiceSheet = ThisWorkbook.Sheets("D")
' clear any data in D
invoiceSheet.Range("B15").Value = ""
invoiceSheet.Range("G10").Value = ""
invoiceSheet.Range("D21:D32").Value = ""
DoEvents
' copy the template from D to be used when creating new sheets
Set invoiceTemplateRange = invoiceSheet.Range("InvoiceTemplate")
invoiceTemplateRange.Copy
CopyDataFromZZToInvoice "D", invoiceSheet
' this turns off Excel displaying edits to the workbook as they happen
' making the code run faster
Application.ScreenUpdating = False
' loop through the remainder of the columns in ZZ sheet
' to create the sheets, copy the template, and fill the data
For zzSheetCol = 5 To zzSheetColumnCount
' add the new worksheet after the last one in the workbook
Set invoiceSheet = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
' assign the column letter as the name of the new sheet
invoiceSheet.Name = Split((zzSheet.Columns(zzSheetCol).Address(, 0)), ":")(0)
' paste the template
With invoiceSheet.Range("B10")
.PasteSpecial xlPasteColumnWidths
.PasteSpecial xlPasteValues, , False, False
.PasteSpecial xlPasteFormats, , False, False
End With
' call the procedure to copy the data
CopyDataFromZZToInvoice invoiceSheet.Name, invoiceSheet
Next zzSheetCol
' release the objects used to access the worksheets
Set invoiceTemplateRange = Nothing
Set invoiceSheet = Nothing
Set zzSheet = Nothing
' this turns it back on
Application.ScreenUpdating = True
End Sub
Private Sub CopyDataFromZZToInvoice(fromColumn As String, toSheet As Worksheet)
' this sub procedure handles copying the data from ZZ to the sheet passed
Dim zzSheetRow As Integer
Dim toSheetRow As Integer
' copy section for item 1
For zzSheetRow = 30 To 33
toSheet.Cells(zzSheetRow - 9, "D").Value = zzSheet.Cells(zzSheetRow, fromColumn).Value
Next zzSheetRow
For zzSheetRow = 35 To 38
toSheet.Cells(zzSheetRow - 6, "D").Value = zzSheet.Cells(zzSheetRow, fromColumn).Value
Next zzSheetRow
' copy data to B15 in template from row 60 of the current column in zz
toSheet.Range("B15").Value = zzSheet.Cells(60, fromColumn).Value
' copy data to G10 in template from row 51 of the current column in zz
toSheet.Range("G10").Value = zzSheet.Cells(51, fromColumn).Value
End Sub
Add this to the Dim area at the top of the button code
Code:
Dim invoiceTemplateLogo As Shape
change the path F:\Temp\logo.jpg to point to where your logo file is located.
Code:
' add the Logo to the new invoice sheet
Set invoiceTemplateLogo = invoiceSheet.Shapes.AddPicture("F:\Temp\logo.jpg", False, True, 20, 20, -1, -1)
With invoiceTemplateLogo
.Top = invoiceSheet.Cells(10, 5).Top 'according to variables from correct answer
.Left = invoiceSheet.Cells(10, 5).Left
.LockAspectRatio = msoFalse
End With
Set invoiceTemplateLogo = Nothing
put this code just after:
Code:
' paste the template
With invoiceSheet.Range("B10")
.PasteSpecial xlPasteColumnWidths
.PasteSpecial xlPasteValues, , False, False
.PasteSpecial xlPasteFormats, , False, False
.PasteSpecial xlPasteFormulas, , False, False
End With
' call the procedure to copy the data
CopyDataFromZZToInvoice invoiceSheet.Name, invoiceSheet
It will add the picture to the sheet at row 10 col E
You're saying that the template now starts in A1 and not at row 10? You'll have to modify the procedure CopyDataFromZZToInvoice so that is copies to the proper locations.
This part here, in btnCreateSheets_Click(), creates the new invoice sheet, then pastes the template to it.
Code:
' add the new worksheet after the last one in the workbook
Set invoiceSheet = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
' assign the column letter as the name of the new sheet
invoiceSheet.Name = Split((zzSheet.Columns(zzSheetCol).Address(, 0)), ":")(0)
' paste the template
With invoiceSheet.Range("B10")
.PasteSpecial xlPasteColumnWidths
.PasteSpecial xlPasteValues, , False, False
.PasteSpecial xlPasteFormats, , False, False
.PasteSpecial xlPasteFormulas, , False, False
End With
How to set the printing range for below code?
I added below code but it didn't work
Set rng = ws.Range("A1:G39")
&
Also i need to exclude ZZ sheet from the single pdf file which is saved
need to save as a single pdf file
HTML Code:
Sub Printddd2()
'
' Printddd Macro
'
' Keyboard Shortcut: Ctrl+Shift+I
'
'Create and assign variables
Dim saveLocation As String
saveLocation = "D:\COSCO\Custom OT\myPDFFile.pdf"
'Save Active Sheet(s) as PDF
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=saveLocation
Last edited by dinukamp; May 28th, 2024 at 09:05 AM.
Hi
i used this macro for the above printing requirement but it doesn't work properly
I need all tabs to be saved as a single PDF excluding ZZ tab.
Print area of each tab is A1:G39
Please help
Code:
Sub Printddd2()
'
' Printddd Macro'
' Keyboard Shortcut: Ctrl+Shift+I'
'Create and assign variables
Dim saveLocation As String
saveLocation = "D:\myPDFFile.pdf"
Dim ws As Worksheet
Dim printRange As Range
'Save Active Sheet(s) as PDF
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "ZZ" Then
Set printRange = ws.Range("$A$1:$G$39")
With ws.PageSetup
.PrintArea = printRange.Address
.FitToPagesWide = 1
.FitToPagesTall = False
End With
ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=saveLocation
End If
Next ws
End Sub
I'm glad you tried, here is code I used to export the sheet after it has been created.
This goes in the loop just above "Next zzSheetCol"
Code:
' export the sheet to its own PDF file
ExportInvoiceSheetToPDF invoiceSheet
which calls this sub routine that can be placed anywhere in the same module
Code:
Private Sub ExportInvoiceSheetToPDF(invoiceSheet As Worksheet)
' take the sheet passed and export the invoice range to a PDF
' of the same name
Dim pdfFileName As String
Dim pdfRange As Range
' create the file name to save it to
pdfFileName = "F:\Temp\" & Format(Date, "MM_dd_yyyy") & " Sheet " & invoiceSheet.Name & ".pdf"
' set the range to export from
Set pdfRange = invoiceSheet.Range("A1:G39")
pdfRange.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfFileName, OpenAfterPublish:=False ' export the range
Set pdfRange = Nothing
End Sub
change the pdfFile path variable to save the file to the location you need. EDIT: also set whatever properties you need when exporting the range.
EDIT2: removed colon from filename
Last edited by jdelano; May 29th, 2024 at 06:20 AM.
My mistake I misunderstood, sorry about that, see the mods in the for loop as well as add Dim printRange As Range to the top of btnCreateSheets_Click()
Code:
For zzSheetCol = 5 To zzSheetColumnCount
' add the new worksheet after the last one in the workbook
Set invoiceSheet = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
' set up the print range on each worksheet added
Set printRange = invoiceSheet.Range("$A$1:$G$39")
With invoiceSheet.PageSetup
.PrintArea = printRange.Address
.FitToPagesWide = 1
.FitToPagesTall = False
End With
' assign the column letter as the name of the new sheet
invoiceSheet.Name = Split((zzSheet.Columns(zzSheetCol).Address(, 0)), ":")(0)
' paste the template
With invoiceSheet.Range("B10")
.PasteSpecial xlPasteColumnWidths
.PasteSpecial xlPasteValues, , False, False
.PasteSpecial xlPasteFormats, , False, False
.PasteSpecial xlPasteFormulas, , False, False
End With
' call the procedure to copy the data
CopyDataFromZZToInvoice invoiceSheet.Name, invoiceSheet
' add the Logo to the new invoice sheet
Set invoiceTemplateLogo = invoiceSheet.Shapes.AddPicture("F:\Temp\logo.jpg", False, True, 20, 20, -1, -1)
With invoiceTemplateLogo
.Top = invoiceSheet.Cells(10, 5).Top 'according to variables from correct answer
.Left = invoiceSheet.Cells(10, 5).Left
.LockAspectRatio = msoFalse
End With
Set invoiceTemplateLogo = Nothing
Set printRange = Nothing
Next zzSheetCol
' release the objects used to access the worksheets
Set invoiceTemplateRange = Nothing
Set invoiceSheet = Nothing
' export the sheets to a PDF file
zzSheet.Visible = xlSheetHidden ' hide the ZZ tab from being included with the PDF
ThisWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:="F:\Temp\Invoices created " & Format(Date, "MM-dd-yyy") & ".pdf"
zzSheet.Visible = xlSheetVisible
Set zzSheet = Nothing
You'll need to tweak the settings to ensure each page fits, change the margins of the page setup.
Re: [RESOLVED] Macro for tab wise invoice creation
Tried this code but it is only doing italic not getting bold for once which are available
Code:
Sub USD()
Dim wsUSD As Worksheet
Dim wsLogin As Worksheet
Dim cell As Range
Dim numbers As Variant
Dim number As Variant
Dim found As Range
Set wsUSD = ThisWorkbook.Sheets("111 USD")
Set wsLogin = ThisWorkbook.Sheets("Iogixinv")
For Each cell In wsUSD.Range("T2:T" & wsUSD.Cells(wsUSD.Rows.Count, "T").End(xlUp).Row)
numbers = Split(cell.Value, ";")
For Each number In numbers
number = Trim(number)
Set found = wsLogin.Columns("E").Find(what:=number, LookIn:=xlValues, LookAt:=xlWhole)
If Not found Is Nothing Then
cell.Font.Bold = True
Else
cell.Font.Italic = True
End If
Next number
Next cell
End Sub
Re: [RESOLVED] Macro for tab wise invoice creation
Because the cell you're searching is a merged cell (as pointed out in the comments of my code) you need to include both columns of the merged cell when using the Range.Find method .. eh you've replied on an old post I helped you with last May.
Code:
' because the data being searched is in a merged cell, both columns
' need to be included in the find method
Set findRange = iogixinvWS.Range("D:E").Find(what:=invNumber, LookIn:=xlValues)