Yam Code
Sign up
Login
New paste
Home
Trending
Archive
English
English
Tiếng Việt
भारत
Sign up
Login
New Paste
Browse
'TODO: Automatically add image to the cell 'Using: insertImage(Destination, Image Path) Option Explicit Function insertImage(dest As Range, imgPath As Range) As String InsertPicture imgPath, dest, True insertImage = "" End Function Private Function AutoPicture(rPath As Range) Dim ca As Range Application.Volatile Set ca = Application.Caller AutoPicture = InsertPicture(rPath, Application.Caller, False) End Function Private Sub ClearPicture(rrg As Range, isSubCall As Boolean) Dim Ws As Worksheet Dim pPics As Pictures Dim pPic As Picture On Error Resume Next Set Ws = rrg.Worksheet If isSubCall = True Then Set pPics = Ws.Pictures For Each pPic In pPics If Not (Application.Intersect(rrg, pPic.TopLeftCell) Is Nothing) Then If Not (Application.Intersect(rrg, pPic.BottomRightCell) Is Nothing) Then pPic.Delete End If End If Next Else Dim rIndex As Range For Each rIndex In rrg Set pPic = Ws.Shapes(rIndex) pPic.Delete Next End If End Sub Private Function InsertPicture(rS As Range, rD As Range, Optional isSubCall As Boolean = True) Dim lRows As Long Dim lCols As Long Dim lRow As Long Dim lCol As Long Dim rrg As Range Dim Pic As Shape Dim Ws As Worksheet Set Ws = rD.Worksheet lRows = rS.Rows.Count lCols = rD.Columns.Count If rS.Rows.Count <> rD.Rows.Count Or rS.Columns.Count <> rD.Columns.Count Then InsertPicture = CVErr(xlErrNA): Exit Function On Error Resume Next If isSubCall = True Then If MsgBox("Do you want to remove the old image in the cell?", vbYesNo) = vbYes Then ClearPicture rD, True End If Else ClearPicture rD, False End If Dim vKQ() As Variant ReDim vKQ(1 To lRows, 1 To lCols) As Variant For lRow = 1 To lRows For lCol = 1 To lCols Set rrg = rD(lRow, lCol) Err.Clear Set Pic = Ws.Shapes.AddPicture(rS(lRow, lCol), msoFalse, msoTrue, 1, 1, -1, -1) If Err.Number <> 0 Then vKQ(lRow, lCol) = CVErr(xlErrNA) Else vKQ(lRow, lCol) = Pic.Name Pic.Placement = xlMoveAndSize ReSizeShape Pic, rrg End If Next Next lRow InsertPicture = vKQ End Function Private Sub ReSizeShape(a As Shape, rrg As Range) Dim shr As Single Dim swr As Single Dim sha As Single Dim swa As Single Dim sTyLe As Single a.LockAspectRatio = msoFalse a.ScaleHeight 1, msoTrue, msoScaleFromMiddle a.ScaleWidth 1, msoTrue, msoScaleFromMiddle shr = rrg.MergeArea.Height swr = rrg.MergeArea.Width sha = a.Height swa = a.Width sTyLe = 10 If (shr / swr) >= (sha / swa) Then a.Width = swr * (100 - sTyLe) / 100 a.Height = (a.Width * sha) / swa Else a.Height = shr * (100 - sTyLe) / 100 a.Width = (a.Height * swa) / sha End If a.Left = rrg.Left + (swr - a.Width) / 2 a.Top = rrg.Top + (shr - a.Height) / 2 a.LockAspectRatio = msoTrue End Sub
Paste Settings
Paste Title :
[Optional]
Paste Folder :
[Optional]
Select
Syntax Highlighting :
[Optional]
Select
Markup
CSS
JavaScript
Bash
C
C#
C++
Java
JSON
Lua
Plaintext
C-like
ABAP
ActionScript
Ada
Apache Configuration
APL
AppleScript
Arduino
ARFF
AsciiDoc
6502 Assembly
ASP.NET (C#)
AutoHotKey
AutoIt
Basic
Batch
Bison
Brainfuck
Bro
CoffeeScript
Clojure
Crystal
Content-Security-Policy
CSS Extras
D
Dart
Diff
Django/Jinja2
Docker
Eiffel
Elixir
Elm
ERB
Erlang
F#
Flow
Fortran
GEDCOM
Gherkin
Git
GLSL
GameMaker Language
Go
GraphQL
Groovy
Haml
Handlebars
Haskell
Haxe
HTTP
HTTP Public-Key-Pins
HTTP Strict-Transport-Security
IchigoJam
Icon
Inform 7
INI
IO
J
Jolie
Julia
Keyman
Kotlin
LaTeX
Less
Liquid
Lisp
LiveScript
LOLCODE
Makefile
Markdown
Markup templating
MATLAB
MEL
Mizar
Monkey
N4JS
NASM
nginx
Nim
Nix
NSIS
Objective-C
OCaml
OpenCL
Oz
PARI/GP
Parser
Pascal
Perl
PHP
PHP Extras
PL/SQL
PowerShell
Processing
Prolog
.properties
Protocol Buffers
Pug
Puppet
Pure
Python
Q (kdb+ database)
Qore
R
React JSX
React TSX
Ren'py
Reason
reST (reStructuredText)
Rip
Roboconf
Ruby
Rust
SAS
Sass (Sass)
Sass (Scss)
Scala
Scheme
Smalltalk
Smarty
SQL
Soy (Closure Template)
Stylus
Swift
TAP
Tcl
Textile
Template Toolkit 2
Twig
TypeScript
VB.Net
Velocity
Verilog
VHDL
vim
Visual Basic
WebAssembly
Wiki markup
Xeora
Xojo (REALbasic)
XQuery
YAML
HTML
Paste Expiration :
[Optional]
Never
Self Destroy
10 Minutes
1 Hour
1 Day
1 Week
2 Weeks
1 Month
6 Months
1 Year
Paste Status :
[Optional]
Public
Unlisted
Private (members only)
Password :
[Optional]
Description:
[Optional]
Tags:
[Optional]
Encrypt Paste
(
?
)
Create New Paste
You are currently not logged in, this means you can not edit or delete anything you paste.
Sign Up
or
Login
Site Languages
×
English
Tiếng Việt
भारत