Posts by chirayuw

chirayuw · Apr 13th 2013

Re: Macro - Paste pic to powerpoint

Hi VBA_Wizard,

I used Activesheet.Cells.Select because I have hidden columns and rows and they do not get selected when using this code. These vary from file to file but the procedure is the same - copy activesheet visible range and paste as picture. So the issue of the picture being small in a grey tile does not arise.

The odd part is if I replace the code to create a New PPT instead of Opening one I already made - it is able to paste the picture in the slide.

I did select the reference manually because for some reason the vba code is not enabling it automatically.

Heres the code that creates a New PPT

Code

Sub New_PPT_Pic()
    
    
    'Activate Powerpoint references
    
    On Error Resume Next
      Application.VBE.ActiveVBProject.References.AddFromFile "C:\Program Files\Microsoft OfficeXP\Office10\MSPPT.OLB"
    On Error Resume Next
      Application.VBE.ActiveVBProject.References.AddFromFile "C:\Program Files\Microsoft Office\Office11\MSPPT.OLB"
    On Error Resume Next
      Application.VBE.ActiveVBProject.References.AddFromFile "C:\Program Files\Microsoft Office\Office12\MSPPT.OLB"
    On Error Resume Next
      Application.VBE.ActiveVBProject.References.AddFromFile "C:\Program Files\Microsoft Office\Office14\MSPPT.OLB"
    
    
    '==================================================================================================================
    
    
    'Copy range from main sheet as pic
    
    Range("A1").Select
    ActiveSheet.Cells.Select
    Selection.CopyPicture
    
    'Paste as pic in new sheet called ppt and reisze pic
    
    Worksheets.Add.Name = "pptpic"
    Range("A1").Select
    ActiveSheet.PasteSpecial Picture
    Selection.ShapeRange.LockAspectRatio = msoFalse
    Selection.ShapeRange.Width = 650
    Selection.ShapeRange.Height = 315
    Selection.ShapeRange.Left = 0
    Selection.shaperang.Top = 0
    
    'Give pic white background
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
    'Copy the picture
    Selection.Copy
    
    '==================================================================================================================
    
    
    'Open new Powerpoint
    
    Dim NewPPT As PowerPoint.Application
    Set NewPPT = CreateObject("PowerPoint.Application")
    NewPPT.Visible = msoTrue
    
    'Add presentation if not there
    
    Dim NewPresenation As PowerPoint.Presentation
    If NewPPT.Presentations.Count = 0 Then
    Set NewPresentation = NewPPT.Presentations.Add
    Else
        Set NewPresentation = NewPPT.ActivePresentation
    End If
    
    'Add title slide if not there
    
    Dim NewSlide As PowerPoint.Slide
    If NewPresentation.Slides.Count = 0 Then
    Set NewSlide = NewPresentation.Slides.Add(1, ppLayoutTitle).Select
    Set NewSlide = NewPresentation.Slides.Add(2, ppLayoutTitleOnly).Select
    Else
    ActivePresentation.Slides.Range.Select
    End If
         
    'Paste pic
    NewPPT.ActivePresentation.Slides(2).Select
    NewPPT.ActiveWindow.View.Paste
    
    
    '==================================================================================================================
    
    
    'Save Powerpoint
    
    Dim ppapp As Object
    Set ppapp = GetObject(, "Powerpoint.Application")
    ppapp.FileDialog(msoFileDialogSaveAs).Show
    
    'Delete PPT sheet
    
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("pptpic").Delete
    Application.DisplayAlerts = True
        
    'Close Excel
    ActiveWorkbook.Save
    
End Sub

Display More

chirayuw · Apr 12th 2013

Re: Macro - Paste pic to powerpoint

Hi VBA_Wizard,

Same issue. It is still unable to paste the pic.

I checked the sheet it was supposed to copy and it would seem that the change in the selection method is not selecting the activesheet area, and hence is pasting a blank copy.

Before:

Code

'Copy range from main sheet as pic


Range("A1").Select
ActiveSheet.Cells.Select
Selection.CopyPicture

After:

Code

'Copy range from main sheet as pic


Range("A1").CurrentRegion.Select
Selection.Copy

chirayuw · Apr 11th 2013

Hi all,

I'm having trouble finishing part of my macro code. Basically what it does is it firstly take the activesheet range and converts it to a picture and then pastes this and resizes it on a new sheet called 'pptpic'. The it opens a powerpoint file I have already made and kept in the same folder called 'test.ppt'. Here is where my macro fails, as it is unable to paste the picture from excel into powerpoint on slide 2. The slide format is TitleOnly. So I would like a way to paste the pic into slide 2 of 'test.ppt'.

Code

Sub Open_PPT_Pic()


    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("pptpic").Delete
    Application.DisplayAlerts = True
    
    
    '============================
    
    
    'Activate Powerpoint references
    
    On Error Resume Next
      Application.VBE.ActiveVBProject.References.AddFromFile "C:\Program Files\Microsoft OfficeXP\Office10\MSPPT.OLB"
    On Error Resume Next
      Application.VBE.ActiveVBProject.References.AddFromFile "C:\Program Files\Microsoft Office\Office11\MSPPT.OLB"
    On Error Resume Next
      Application.VBE.ActiveVBProject.References.AddFromFile "C:\Program Files\Microsoft Office\Office12\MSPPT.OLB"
    On Error Resume Next
      Application.VBE.ActiveVBProject.References.AddFromFile "C:\Program Files\Microsoft Office\Office14\MSPPT.OLB"
    
    
    '===========================
    
    
    'Copy range from main sheet as pic
    
    Range("A1").Select
    ActiveSheet.Cells.Select
    Selection.CopyPicture
    
    'Paste as pic in new sheet called ppt and reisze pic
    
    Worksheets.Add.Name = "pptpic"
    Range("A1").Select
    ActiveSheet.PasteSpecial Picture
    Selection.ShapeRange.LockAspectRatio = msoTrue
    'Selection.ShapeRange.Width = 660
    Selection.ShapeRange.Height = 215
    Selection.ShapeRange.Left = 0
    
    'Give pic white background
    
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    
    'Copy the picture
    
    Selection.Copy
    
    '===========================
    
    
    'Open Powerpoint
    
    Dim PPT As PowerPoint.Application
    Set PPT = CreateObject("PowerPoint.Application")
    PPT.Visible = msoTrue
    PPT.Presentations.Open Filename:=ThisWorkbook.Path & "\test.ppt"
       
    'Paste pic
    PPT.ActiveWindow.View.Paste
    


    '==========================


    'Save Powerpoint


    Dim ppapp As Object
    Set ppapp = GetObject(, "Powerpoint.Application")
    ppapp.FileDialog(msoFileDialogSaveAs).Show




End Sub

Display More

chirayuw · Nov 19th 2012

Re: Copy data from multiple sheets to one sheet

Thanks Roy, works great

chirayuw · Nov 19th 2012

Re: Copy data from multiple sheets to one sheet

Hi Roy,

Your version only takes into account 1 sheet as exclusion. As shown in macro, I am trying to exclude multiple sheets using MyArray (Variant). How would i accomplish this.

chirayuw · Nov 19th 2012

Hi All. Basically I created a macro by searching online however it is not following the <> rule and instead copies from all sheets so I need help to fix it. Thanks in advance.

Code

Sub Consolidate_Data()


'Set my own sheet list array
Dim MyArray As Variant
MyArray = Array("Consolidated", "Home", "ACL Sheet", "Doc info", "Active Pending", "database")


'main macro copying unknown x number of sheets and unknown length range
For Each ws In Worksheets
    If ws.Name <> "MyArray" Then
    ws.Range("A2:P" & ws.Range("A" & Rows.Count).End(xlUp).Row).Copy
    Worksheets("Consolidated").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
End If
Next ws


'go back to top
Worksheets("Consolidated").Select
Range("A1").Select


End Sub

Display More

chirayuw · Aug 1st 2012

Here's a Log File Template I created. When run, it creates a message box that tells you thank you for using the macro and it uses system information to show your userid and username. It furthermore pastes this data on the sheet, with the date and time of use. The password to view or edit the code is 1. The macro also protects the sheet after completion so that generated data cannot be deleted. Password for sheet is also 1.

forum.ozgrid.com/index.php?attachment/47528/

chirayuw · May 24th 2012

Re: Copying from Closed .csv file to open Active Sheet

You're welcome. To be honest I myself am new to macros. I've basically learnt over two weeks. Part through recording and part through reading online

chirayuw · May 24th 2012

Re: Excel2007 Cond. Formatting-highlight a cell when a different cell is >0 & text ms

I didn't create a macro for it as the same result can be achieved using formulas. Example file attached.

forum.ozgrid.com/index.php?attachment/45983/

chirayuw · May 24th 2012

Re: Copying from Closed .csv file to open Active Sheet

Here is the Macro. It does assume that the headings in your csv file begin in the first row and the data begins in the second. edit accordingly and if you need an example file then tell me. Also the -ThisWorbook.Path & - fuction essentially requires you to have the csv file in the same location as your calculation file. otherwise give it a specified path e.g. "C:\....."

Code

Sub Macro1()
    'Activate your macro file and range
    Windows("MyFileName.xlsm").Activate
    ActiveSheet.Range("A2").Select
    'Open the csv file
    Workbooks.Open Filename:= _
            ThisWorkbook.Path & "\MyCSVFileName.csv"
    'Activate your csv file
    Windows("MyCSVFilename.csv").Activate
    Sheets("MyCSVSheetName").Select
    Range("A1").Select
    'Autofilter your range and copy (It assumes that your heading are in the first row and your range begins from the second row in column F)
    Selection.AutoFilter
    ActiveSheet.Range(Selection, Selection.End(xlToRight)).AutoFilter Field:=6, Criteria1:="=7A*", _
        Operator:=xlAnd
    'Copy filtered
    Dim rTable As Range
    Set rTable = ActiveSheet.AutoFilter.Range
    Set rTable = rTable.Resize(rTable.Rows.Count - 1)
    'Move new range down to start at the first data row and create new sheet and copy data there
    Set rTable = rTable.Offset(1)
    rTable.Copy
    Sheets.Add.Name = "table"
    Sheets("table").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    'Copy from new sheet
    Sheets("table").Select
    Range("F1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    'Copy to your original file
    Windows("MyFileName.xlsm").Activate
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False 
    'Close the csv file without saving it
    Windows("MyCSVFileName.csv").Activate
    Workbooks("MyCSVFileName.csv").Close False
    'Return to your file and save it
    Windows("MyFileName.xlsm").Activate
    ActiveWorkbook.Save     
End Sub

Display More

chirayuw · May 21st 2012

Re: VBA Copy Data According to Date and Site

Nevermind I solved this issue a few days ago. I basically created a new sheet and placed the template of each table on the sheet and used an index match function to get the specifed date data from a given cell i.e. i would enter a date in one cell and based upon that the cells in the formula sheet would pull data for only that date and table as each range is specified. Simple yet elegant solution lol. then it was just a matter of using a copy paste macro from new sheet to original sheet. if anyone needs an example of what i did, then just post below and i'll amend my example file accordingly and reupload.

chirayuw · May 14th 2012

Re: VBA Autofilter & Subtotal or Sum to combine with Unkown column length

Nevermind. I solved the issue myself by some hard thinking lol. Basically I recorded new vb macro that just copies the filtered data, opens a new sheet, value pastes the data, autofits the columns, and then runs my unkown column length macro to get the sum. Here is the finished code for people who are thinking of doing something similar.

Code

Sub La()
Windows("POD.xlsm").Activate
Sheets("Main Sheet").Select
Range("B25").Select
'Open LA data file and filter
Workbooks.Open Filename:= _
        "C:\Users\me\Desktop\POD\queue report\LA.xls"
Windows("LA.xls").Activate
'Auto Filter and select the data I want
Selection.AutoFilter
Range("C1").Select
ActiveSheet.Range("$A$1:$H$277").AutoFilter Field:=3, Criteria1:=Array( _
    "LA2 ams", "LA2 rejnbal", "LA Amt Ent", _
    "LA R&B"), Operator:=xlFilterValues
Range("D1").Select
ActiveSheet.Range("$A$1:$H$277").AutoFilter Field:=4, Criteria1:=Array("1", _
    "12", "14", "18", "2", "21", "23", "35", "4", "6", "8"), Operator:=xlFilterValues
'Copy filter and value paste to new sheet and autofit columns
Range("A:H").Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Columns("A:H").EntireColumn.AutoFit
'Sum my unkown range for column D, then copy the sum and value paste in my POD file in cell B25, then save
Dim myrng As Long
Set i = Sheets(ActiveSheet.Name).UsedRange.Rows
myrng = i.Count
Range("D65536").End(xlUp).Offset(1, 0) = Application.WorksheetFunction.Sum(Range("D1:D" & myrng))
Range("D65536").End(xlUp).Activate
ActiveCell.Select
ActiveCell.Copy
Windows("POD.xlsm").Activate
Sheets("Main Sheet").Select
Range("B25").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
ActiveWorkbook.Save
'Close LA data file without saving
Windows("LA.xls").Activate
Workbooks("LA.xls").Close False
'Go back to POD file and end sub
Windows("POD.xlsm").Activate
End Sub

Display More

chirayuw · May 11th 2012

Ok so basically am a noob at VBA. But I have made some macro's by recording/ searching online but have now gotten stuck. I have two macro's. One sum's and unkown range and copies it to a sheet, whereas the other has autofilter option on it. I want to be able to essentially merge the two macro's so that it can use the autofilter as well as sum using my unkown range macro, because my data changes everyday. Please provide some insight into how I can achieve this. I tried by myself and failed. I tried using subtotal or r1c1 by looking at online formulas but clearly i am not as adept in vba lol. Below are the two macro's

Autofilter

Code

Sub Macro1()


    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$H$277").AutoFilter Field:=3, Criteria1:=Array( _
        "LA2 ams", "LA2 rejnbal", "Los AmEnt", _
        "Los R&B"), Operator:=xlFilterValues
    ActiveSheet.Range("$A$1:$H$277").AutoFilter Field:=4, Criteria1:=Array("1", _
        "12", "14", "18", "2", "21", "23", "35", "4", "6", "8"), Operator:=xlFilterValues


End Sub

Display More

Unkown Range sum and copy sum to diff sheet

Code

Sub LR()


'LR


Sheets("Main Sheet").Select
Range("B24").Select
Workbooks.Open Filename:= _
        "C:\Users\me\Desktop\POD\queue report\LR.xls"
Windows("LR.xls").Activate
Dim myrng As Long
Set i = Sheets(ActiveSheet.Name).UsedRange.Rows
myrng = i.Count
Range("D65536").End(xlUp).Offset(1, 0) = Application.WorksheetFunction.Sum(Range("D2:D" & myrng))
Range("D65536").End(xlUp).Activate
ActiveCell.Select
ActiveCell.Copy
Windows("POD.xlsm").Activate
Sheets("Main Sheet").Select
Range("B24").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
ActiveWorkbook.Save
Windows("LR.xls").Activate
Workbooks("LR.xls").Close False
Windows("POD.xlsm").Activate


End Sub

Display More

chirayuw · May 10th 2012

Ok basically I'm a complete newbie to macro coding. I only know how to record a macro, nothing else. What i want to do is 1 have 2 sheets in my file e.g. Sheet1 & Sheet2. In Sheet1 I have my raw data for all sites in row format. In sheet 2 I have individual daily adjustments I require as the raw data changes everyday.

Essentially I would like to know a way to create a macro/ have a macro whereby I can match the Date & Site on both sheets. If they match then it should match the column names of Sheet 2 to Sheet1 and Value paste Sheet2 Data on those specific columns in Sheet 1. Also in my actual dataset Sheet1 sitenames are not identical to Sheet2 site names

PFA a dummy sheet I created so u know the format of my data.

Posts by chirayuw

Macro - Paste pic to powerpoint

Macro - Paste pic to powerpoint

Macro - Paste pic to powerpoint

Copy data from multiple sheets to one sheet

Copy data from multiple sheets to one sheet

Copy data from multiple sheets to one sheet

Log File Macro Template

Copying from Closed .csv file to open Active Sheet

If Cell Meets Condition Highlight Another Cell & Display Message

Copying from Closed .csv file to open Active Sheet

VBA Copy Data According to Date and Site

VBA Autofilter & Subtotal or Sum to combine with Unkown column length

VBA Autofilter & Subtotal or Sum to combine with Unkown column length

VBA Copy Data According to Date and Site