新版本参见 http://blog.sciencenet.cn/home.php?mod=space&uid=255662&do=blog&id=835970

注： 本文需要读者了解：

1. R函数的基本知识
2. 编写R程序包
3. C++的基础知识， 包括 类， 以及namespace等。

为什么要用R调用C++函数？ 原因可能有以下几点：

1. R开发虽然很快， 涉及到一些循环的时候， 执行效率却常常相当于C++的1/100，甚至更慢

2. C++中有一些已经开发好的库， 人们不希望再重写一遍R的代码。 而是最好通过编译之后直接调用。

Rcpp程序包为用R调用C++代码提供了方便。

用户直接在R的源代码src文件夹下加入cpp和h文件， rtools即可对C++文件进行编译。 但是为了从R的console能够直接调用cpp写的函数， 还必须对cpp的函数进行修改。

修改需要遵循以下原则：

1. 所有从R输入到cpp的对象， 都是SEXP
2. 从cpp返回到R的对象也必须是SEXP
3. C++中， 返回值如为数值， 可以用wrap()帮忙， 直接返回为SEXP的对象， 实现R的调用

换句话说， 只有加了SEXP这样一个标签，C++函数在 R和C++中才都能识别。 Rcpp提供了SEXP处理的响应的类， 使得两者之间的数据传输变得容易。

以下是用R调用C++的一个简单例子：

如果在windows中要使用Rcpp， 则需要

1. 安装Rcpp程序包，install.packages(“Rcpp”)

2. 安装Rtools， 并配制好启动路径。电脑>属性>高级系统设置>高级>环境变量>系统变量>路径

3. 在R console 中运行 library(Rcpp) ， 之后调用 Rcpp.package.skeleton函数，

1

Rcpp.package.skeleton( "test" )

在生成的R包 skeleton中， 可以找到rcpp_hello_world.cpp文件， 可以尝试添加几个函数， 修改成如下样式 （注意以下代码为C++文件,扩展名为cpp):

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48

////////////////////// C++文件开始//////////////////
#include "rcpp_hello_world.h"
#include <Rcpp.h>
using namespace Rcpp;
using namespace std;
// 注意 #include <Rcpp.h> 是调用Rcpp的必要条件

RcppExport SEXP intVec1a(SEXP vec) {
   Rcpp::NumericVector vec2(vec);
   int prod = 1;
   for (int i=0; i<vec2.size(); i++) {
       prod *= vec2[i];
   }
   return (wrap(prod));
}

// RcppExport 是为了在载入R包后， 在Namespace内内能够找到这个C++的函数

//第一个SEXP声明返回值的类型

//第二个SEXP， 声明vec变量为SEXP的类型，也就是说， 它可以是从R直接传入

// Rcpp::NumericVector vec2(vec); 意思 是将 vec转换为 vec2， 从SEXP转换为 NumericVector， NumericVector是Rcpp下的一个类， 在C++的函数中可以识别和调用。 后面的代码就和普通的C++没有什么分别了。

//return (wrap(prod)); 由于我们希望在R中直接可以得到该函数的运行结果， 因此， 返回值也需要转换为SEXP类型。 wrap函数提供了一种便捷的方式。 简单的类型， 如int， double等， 只需要直接调用wrap即可。 


RcppExport SEXP Eccentricity(SEXP JD)
{ 
 double JD3  = Rcpp::as<double>(JD);
 double T = (JD3 - 2451545.0) / 36525.0;
 double Tsquared = T*T;
 return (wrap(1 - 0.002516*T - 0.0000074*Tsquared));
}
// Rcpp::as<double>(JD); 表示调用Rcpp内的方法， 将类型为SEXP的JD， 转换为double类型， 并赋值給double JD3

RcppExport SEXP expfun(SEXP x){
    double x2 = Rcpp::as<double>(x);
    double ans=1.0, term=1.0, eps=1e-16;
    int n=0;
    while (fabs(term)>eps){
       n++;
       term = term * x2 / n;
       ans = ans + term;
    }
      return(wrap(ans));
}
//  C++文件结束//

对R程序包test的骨架进行修改后， 即可开始安装，

在windows下， 在 开始， cmd， 输入 Rcmd INSTALL test, 安装test程序包

之后转入 R console， library(test)

即可加载响应的动态链接库dll文件。 只是此时调用dll中的文件， 还稍微有些不方便。 此时调用dll中函数的方法如下

1
2
3

.Call('Eccentricity', JD= 2314543)
.Call('intVec1a', vec= c(3, 4, 5))
.Call('expfun', x=3)

不过每次使用.Call函数， 仍然让人觉得不太满意。为了需要写一个R的wrapper function例如

1
2
3
4
5
6
7
8
9
10
11

expfunR <- function(x){
   return( .Call('expfun', x= x))
}

EccentricityR <- function(JD){
   return( .Call('Eccentricity', JD= JD))
}

intVecR <- function(x){
   return(.Call('intVec1a', vec= x))
}

调用方式同R函数，

1
2
3

expfunR(2)
EccentricityR(2314543)
intVecR(c(2,3,4))

这时候就和一般的R函数没有区别了。

用R绘制地图，或者三维图时， 有时候需要添加指北针， 但是很多时候很难进行角度调整等。 这里提供了两个绘制指北针的函数。 可以调整中心点坐标， 指北针的大小，以及旋转的角度， 分别用于二维平面作图和三维作图。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60

\### 可以调整大小，以及旋转的指北针
\### location 设置指北针中心点， 的x, y, z坐标。
\### size 为指北针大小的控制变量，单位为3D图形中的1，
\### rotation为指北针指向的控制变量， 单位为弧度。
northarrow <-function(location =c(0,0), size =1, rotation =0){
   nnn <-par("cin")
   x1 =(c(-2,0,0)*size+location[1])
   y1 =c(-3.5, -2, 3.5)*size+location[2]
   xx1 <-(x1-location[1])*cos(rotation)-   (y1 - location[2])*sin(rotation)+ location[1];  
   yy1   =(x1-location[1])*sin(rotation)+   (y1 - location[2])*cos(rotation)  +  location[2];  
   polygon(xx1, yy1, col=1)
   x2 =c(2,0,0)*size+location[1]
   y2 =c(-3.5, -2, 3.5)*size+location[2]
   xx2 <-(x2-location[1])*cos(rotation)-   (y2 - location[2])*sin(rotation)+ location[1];  
   yy2   =(x2-location[1])*sin(rotation)+   (y2 - location[2])*cos(rotation)  +  location[2];  
   polygon(xx2, yy2, col=0, border =1)
   return(invisible(list(xx1, yy1, xx2, yy2)))
}
plot(0:100, 0:100, pch ="")
north <- northarrow(location =c(10,10),            rotation =(pi/180)*45)
north <- northarrow(location =c(25,25),size =2,   rotation =(pi/180)*90)
north <- northarrow(location =c(50,50),size =0.5,rotation =(pi/180)*180)
north <- northarrow(location =c(75,75),size =2.5,rotation =(pi/180)*270)
\######################################
# northarrow.3D 可以用在三维图中。
\### location 设置指北针中心点， 的x, y, z坐标。
\### pmat为persp的坐标矩阵。
\### size 为指北针大小的控制变量，单位为3D图形中的1，
\### rotation为指北针指向的控制变量， 单位为弧度。
northarrow.3D <-function(location =c(80, 60, 260), pmat, size =5, rotation =0){
   x1 =(c(-2,0,0)*size+location[1])
   y1 =c(-3.5, -2, 3.5)*size+location[2]
   xx1 <-(x1-location[1])*cos(rotation)-   (y1 - location[2])*sin(rotation)+ location[1];  
   yy1   =(x1-location[1])*sin(rotation)+   (y1 - location[2])*cos(rotation)  +  location[2];  
   north.res1 <- trans3d(x = xx1, y = yy1, z = location[3], pmat)
   polygon(north.res1[[1]], north.res1[[2]], col=1)
   x2 =c(2,0,0)*size+location[1]
   y2 =c(-3.5, -2, 3.5)*size+location[2]
   xx2 <-(x2-location[1])*cos(rotation)-   (y2 - location[2])*sin(rotation)+ location[1];  
   yy2   =(x2-location[1])*sin(rotation)+   (y2 - location[2])*cos(rotation)  +  location[2];  
   north.res2 <- trans3d(x = xx2, y = yy2, z = location[3], pmat)
   polygon(north.res2[[1]], north.res2[[2]], col=0)
   return(invisible(list(north.res1, north.res2)))
}
\###########################################
\########### 举例###########
x <-seq(-10, 10, length=30)
y <-seq(-10, 10, length=30)
f <-function(x, y){ r <-sqrt(x^2+y^2); 10*sin(r)/r }
z <-outer(x, y, f)
z[is.na(z)]<-1
op <-par(bg ="white")
res <-persp(x, y, z, theta =30, phi =35, expand =0.5, col="grey",
​     ltheta =120,ticktype ="detailed",
​     xlab ="X", ylab ="Y", zlab ="Sinc( r )")
\###
northarrow.3D(location =c(5, 5, 10), pmat = res, size =0.5,rotation =(pi/180)*45)
northarrow.3D(location =c(-5, 5, 10), pmat = res, size =0.8,rotation =(pi/180)*90)
northarrow.3D(location =c(5, -5, 10), pmat = res, size =0.7, rotation =(pi/180)*180)
northarrow.3D(location =c(-5, -5, 10), pmat = res, size =0.6, rotation =(pi/180)*270)

以下函数， 用来计算森林监测样地每个小样方的坡度和坡向以及凹凸度。 这里用到的是Arcgis中的计算方法。
各函数都假设，原点位于西南方向， x向东增加， y向北增加。 函数都已经经过演算， 结果与示例结果相同。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125

## Calculating theslopes for each grid in a forest dynamic plot
## Provide thematrix of altitudes
## Provide thecell_size, the altitudes and cell_size must be in the same unit.
## Algorithms couldbe found at ##
##http://webhelp.esri.com/arcgiSDEsktop/9.3/body.cfm?tocVisable=1&ID=-1&TopicName=How%20Slope%20works
## Value: a matrixrepresenting the degrees of each grid.
get_slope <-function(z.mat,cell_size =5){
​    ###Extent the z.mat matrix using the value from the border, so that the slope forthe out most cells could be calculated.
​    z.mat.colbind <-cbind(z.mat[,1], z.mat,z.mat[,ncol(z.mat)])
​    z.mat.rbind <-rbind(c(z.mat[1,1], z.mat[1,], z.mat[1,ncol(z.mat)]),z.mat.colbind,
​                         c(z.mat[nrow(z.mat),1], z.mat[nrow(z.mat),], z.mat[nrow(z.mat), ncol(z.mat)]))
​    z.mat.ext <- z.mat.rbind
​    nrz <-nrow(z.mat.ext)
​    ncz <-ncol(z.mat.ext)
​    slope.mat <-rep(NA, nrz*ncz)
​    dim(slope.mat)<-c(nrz, ncz)  ##Create a Null matrix used in loop
​    for(m in2:(nrz-1)){
​       for(n in2:(ncz-1)){
​           a = z.mat.ext[m-1,n-1]
​           b = z.mat.ext[m-1,n]
​           c=z.mat.ext[m-1,n+1]
​           d = z.mat.ext[m,n-1]
​           e = z.mat.ext[m,n]
​           f = z.mat.ext[m,n+1]
​           g = z.mat.ext[m+1,n-1]
​           h = z.mat.ext[m+1,n]
​           i = z.mat.ext[m+1,n+1]
​           
​           dz_dx =((c+2*f + i)-(a +2*d + g))/(8*cell_size)
​           dz_dy =((g +2*h + i)-(a +2*b +c))/(8*cell_size)
​           slope.mat[m,n]<-atan(sqrt( dz_dx^2+ dz_dy^2))*(180/pi)  
​       }
   }
​    return(slope.mat[c(-1, -nrow(slope.mat)),c(-1, -ncol(slope.mat))])
}
####
#### test.dat2 <-c(50, 30, 8, 45, 30, 10, 50, 30, 10)
#### test.dat.slope2<- matrix(test.dat2, nrow = 3, byrow = FALSE)
#### test.dat.slope2
####get_slope(test.dat.slope2, cell_size = 5)
###################################################################
## Calculating theaspect of each cell within a forest dynamic plot
## Adopted from ESRIhttp://webhelp.esri.com/arcgisdesktop/9.3/body.cfm?tocVisable=1&ID=-1&TopicName=how%20aspect%20works
## the z.mat is anumerical matrix representing the altitude for each cell
## the output is anumerical matrix representing the degree of aspect. Starting from the north,
## This functionassums that The direction of the column, from greater to smaller columns pointsto the north.
get_aspect <-function(z.mat){
​    z.mat.colbind <-cbind(z.mat[,1], z.mat,z.mat[,ncol(z.mat)])
​    z.mat.rbind <-rbind(c(z.mat[1,1], z.mat[1,], z.mat[1,ncol(z.mat)]),z.mat.colbind,
​                         c(z.mat[nrow(z.mat),1], z.mat[nrow(z.mat),], z.mat[nrow(z.mat), ncol(z.mat)]))
​    z.mat.ext <- z.mat.rbind
​    nrz <-nrow(z.mat.ext)
​    ncz <-ncol(z.mat.ext)
​    aspect.mat <-rep(NA, nrz*ncz)
​    dim(aspect.mat)<-c(nrz, ncz)
​    for(m in2:(nrz-1)){
​       for(n in2:(ncz-1)){
​           a = z.mat.ext[m-1,n-1]
​           b = z.mat.ext[m-1,n]
​           c=z.mat.ext[m-1,n+1]
​           d = z.mat.ext[m,n-1]
​           e = z.mat.ext[m,n]
​           f = z.mat.ext[m,n+1]
​           g = z.mat.ext[m+1,n-1]
​           h = z.mat.ext[m+1,n]
​           i = z.mat.ext[m+1,n+1]
​           dz_dx =((c+2*f + i)-(a +2*d + g))/8
​           dz_dy =((g +2*h + i)-(a +2*b +c))/8
​           aspect.mat[m, n]=(180/pi)* atan2(dz_dy, -dz_dx)
​       }
   }
​       format.aspect <-function(aspect){
​          cell = aspect
​          for(i in1:length(aspect)){
​          if(aspect[i]<0){        
​             cell[i]=90.0- aspect[i]        
​             }        
​          elseif(aspect[i]>90.0){        
​             cell[i]=360.0- aspect[i]+90.0        
​             }        
​          else{        
​             cell[i]=90.0- aspect[i]        
​             }        
​          }
​          return(cell)        
​       }
   aspect.mat <- aspect.mat[c(-1, -nrow(aspect.mat)),c(-1, -ncol(aspect.mat))]
   return(format.aspect(aspect.mat))
}
############################################################################
#### test.dat.aspect<- c(101, 101, 101, 92, 92, 91, 85, 85, 84)
####dim(test.dat.aspect) <- c(3, 3)
####image(test.dat.aspect)
#### test.dat.aspect
####get_aspect(test.dat.aspect)
########################Calculating  Convexity###################
get_convexity <-function(z.mat){
​    z.mat.colbind <-cbind(rep(NA, nrow(z.mat)), z.mat, rep(NA, nrow(z.mat)))
​    z.mat.rbind <-rbind(rep(NA, ncol(z.mat)+2), z.mat.colbind, rep(NA, ncol(z.mat)+2))
​    z.mat.ext <- z.mat.rbind
​    nrz <-nrow(z.mat.ext)
​    ncz <-ncol(z.mat.ext)
​    convexity.mat <-rep(NA, nrz*ncz)
​    dim(convexity.mat)<-c(nrz, ncz)
​    for(m in2:(nrz-1)){
​       for(n in2:(ncz-1)){
​           a = z.mat.ext[m-1,n-1]
​           b = z.mat.ext[m-1,n]
​           c=z.mat.ext[m-1,n+1]
​           d = z.mat.ext[m,n-1]
​           e = z.mat.ext[m,n]
​           f = z.mat.ext[m,n+1]
​           g = z.mat.ext[m+1,n-1]
​           h = z.mat.ext[m+1,n]
​           i = z.mat.ext[m+1,n+1]
​           #### Ifna.....
​           all.neighbour <-c(a, b, c, d, f, g, h, i)
​           mean.neighbour <-mean(na.omit(all.neighbour))
​           convexity.mat[m,n]<-(e - mean.neighbour)
​       }
   }
   convexity.mat <- convexity.mat[c(-1, -nrow(convexity.mat)),c(-1, -ncol(convexity.mat))]
   return(convexity.mat)
}

模板如下：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19

\documentclass[11pt,a4paper]{article}
\usepackage{dichokey}
\usepackage{CJK}
\pagestyle{empty}
\begin{document}
\begin{CJK*}{UTF8}{song}
\noindenttextbf{large 香港藤黄科分属检索表}\
\(根据《香港植物志》 (2011)卷I 196页)\
\vspace{2ex}
\begin{Key}{}
\alter 浆果或者核果
\alter 侧脉平行而不分叉， 核果 name{胡桐属Calophyllum}
\alter 侧脉分叉， 浆果name{山竹子属Garcinia}
\alter 蒴果
\alter 灌木或乔木， 叶片无腺点，种子具翅 name{黄牛木属 Cratoxylum} 
\alter 草本，叶片具腺点， 果无翅 name{金丝桃属 Hypericum}
\end{Key}
\end{CJK*}
\end{document}

用pdfLaTeX编译， 编译后的效果如图

例2

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50

\documentclass[15px,a4paper]{article}
\usepackage{dichokey}
\usepackage{CJK}
\linespread{1.2}
\begin{document}
\begin{CJK*}{UTF8}{song}
\noindenttextbf{Largecenterline{广州地区大戟科分属检索表}}\
\centerline{(根据邢福武教授主编《广州野生植物》(2007) 111页)}\
\begin{Key}{}
\alter 三出复叶name{重阳木属}
\alter 单叶
\alter 子房每室有2胚珠，叶柄顶部和叶片基部无腺体
\alter 具花瓣name{土蜜树属}
\alter 无花瓣
\alter 雌花具有花盘和腺体
\alter 子房1-2室，稀3室；核果name{五月茶属}
\alter 子房3-15室，蒴果或浆果状
\alter 雄花有不育雄蕊name{白饭树属}
\alter 雄花无不育雄蕊name{叶下珠属}
\alter 雌花无花盘或腺体
\alter 叶在小枝上不呈两列name{银柴属}
\alter 叶在小枝上排成两列
\alter 雄蕊（3）4-8，花药合生，子房通常4-15室，花柱顶端具裂缝或者小裂齿name{算盘子属}
\alter 雄蕊3，花药通常分离，子房3室，花柱2裂
\alter 花药离生或6深裂，宿存花萼通常陀螺状name{守宫木属}
\alter 花萼6浅裂，宿存花萼盘状 name{黑面神属}
\alter 子房每室具有1枚胚珠，叶柄顶部和叶片基部常有各式腺体
\alter 多为草本
\alter 叶对生，少数为互生，植株具乳汁name{大戟属}
\alter 叶互生，无乳汁
\alter 花序穗状或总状，腋生name{铁苋菜属}
\alter 圆锥花序顶生name{蓖麻属}
\alter 乔木或灌木
\alter 雄花与雌花具花瓣，稀雌花无花瓣
\alter 花丝在花蕾顶部内弯，基部被绵毛name{巴豆属}
\alter 花丝在花蕾顶部不内弯，基部无绵毛name{油桐属}
\alter 雄花与雌花均无花瓣
\alter 雄花簇生于苞腋，再排成穗状花序或者总状花序；花蕾时雄蕊已经伸出
\alter 花雌雄同株，稀雌雄异株，穗状花序顶生name{乌桕属}
\alter 花雌雄异株，总状花序腋生name{白桐树属}
\alter 雄花密集成团伞花序或者簇生，再排成穗状、总状或者圆锥花序，花蕾时雄蕊内藏
\alter 雄花的萼片或者花萼裂片覆瓦状排列name{黄桐属}
\alter 雄花的萼片或者花萼裂片镊合状排列
\alter 叶对生，花雌雄异株name{野桐属}
\alter 叶互生，花雌雄异株或同株
\alter 叶下面和蒴果被散生或密生的颗粒状腺体name{血桐属}
\alter 叶两面和果均无颗粒状腺体name{山麻杆属}
\end{Key}
\end{CJK*}
\end{document}

生物地理学研究和生态学研究中， 经常需要知道某地的温度降水高程等信息。 例如， 要探讨物种的生态位宽度， 物种丰富度随温度， 降水以及最低温， 最高温的关系等。

事实上，世界范围内的温度， 降水， 等温性等信息， 已经可以通过互联网免费获得。 用户用DIVA-GIS免费软件， 即可获得陆地上任意一点的气候信息。 当然， 这个气候图层是空间插值的结果，不过对于大部分地理尺度， 或者区域尺度的研究来说， 已经足够了。

本文简要介绍如何从DIVA-GIS提取气候数据。

第一部分 安装并配置气候信息

用DIVA GIS提取， 从DIVAGIS网站下载对应的气候图层， 就可以提取气候数据

diva-gis需要使用软件对应的气候数据图层， 这些图层可以从diva-gis 网站下载
DIVA-GIS下载的地址为： http://www.diva-gis.org/download

气候图层下载的地址为： http://www.diva-gis.org/climate
或者 http://biogeo.ucdavis.edu/data/climate/worldclim/1_4/diva/diva_worldclim_2-5m.zip

下载后解压缩到一定的文件夹。

首先安装好DIVA-GIS。 设置好气候图层数据。 让diva gis 能够找到。
方法是菜单> tools> option > Climate ， 点击Folder按钮，寻找到你解压缩到文件夹， 然后点apply。如果该界面出现了气候图层，页面上的空格就被填上了， 就好了。

第二部分 下载并载入地图文件。

这里需要注意的，主要是地图的国界线是否有问题， 包括南海诸岛以及麦克马洪线等地方的国界线。

DIVA-GIS用到的地图， 也是shape文件。 这是ArcGIS等设定的地图文件标准，主要分成三种类型（点 Polypoint ， 线(Polyline )和多边形(Polygon )， ）。
然后下载中国的shape文件（http://nfgis.nsdi.gov.cn/nfgis/chinese/c_xz.htm），国外网站的地图是不能随便使用的， 因为涉及到国界的争议。

另外一点要注意的， 是之前采集的数据点， 是否有错误， 所以需要导入经纬度坐标， 做出图来， 并检查其中的错误。

下载好图层文件后， 先加载图层。
Layer > Add layer 然后， 可以点击DIVA-GIS的气候提取按钮， 先看看， 点击按钮一行， 倒数第三个 圈C 按钮。 然后再点击地图中的任意一点
就可以显示气候信息了

第三部分， 导入经纬度坐标

文件应为文本(txt)或者csv格式， 必须要保留三列。 可以在Excel中填写，

1. 地名
2. 经度
3. 纬度
   并且不能用中文， 一概用英文作为列的名称， 并另存为csv文件。

导入方式为 Data > Import Points to shapefile > from txt
然后 在弹出的界面, 点击浏览， 选择你刚刚准备好的csv文件。 Field deliminator选择 逗号。 经纬度要注意匹配， 不能弄混了。 然后点击 apply， 这样数据点就导入了。
如果发现某些数据点的位置出现问题， 则应该修改经纬度记录。

第四部分， 导出气候数据。

导出气候数据的方法为
Data > Extract value by points
做出相应的选择即可。

以下内容整理自和邸鲲的QQ聊天内容，已经获得她的允许， 现做简单的整理， 发到空间， 供对认识植物有兴趣的同仁参考。

邸鲲： 我是初级水平，植物志看得好费劲。看了半天还是没感觉。说实话，文字描述看上去好晕。你都怎么认植物的啊。

张金龙：主要是记忆属的关键特征。

邸鲲： 嗯，好。谢谢。继续努力。

张金龙： 要认识植物，需要看如下特征。 草本， 木本， 单叶， 复叶， 纸质， 革质， 肉质，有没有叶柄， 有没有托叶， 托叶的形状， 托叶痕迹的形状， 小枝有没有棱， 叶片上有没有腺体。 叶片是全缘， 还是有锯齿。 是什么类型的锯齿。 毛的颜色和类型。叶尖， 叶基的形状。 叶脉的类型， 是否在正面突起，或者凹陷。叶片和叶柄是否有一定的夹角。 苞片的形状。颜色， 毛被。 花序的类型。

邸鲲 ：嘿嘿，感觉有的人一看就认识，要是让他说个一二三，他还讲不了那么清楚。

张金龙： 花萼，花瓣， 雄蕊的数目；花瓣是否合生为花冠筒； 花冠裂片的形状和数目。

邸鲲 ：嗯哪，很详细，都是植物学上的知识。当年就头疼这些，看来还是有用哈。

张金龙： 花瓣的排列方式，如啮合状排列，螺旋状排列， 覆瓦状排列。 花药的着生方式， 心皮的数目； 胚珠的数目和着生方式； 是否有毛。

邸鲲 ：心皮的数目，胚珠的数目，肉眼不可辨识吧？

张金龙： 需要放大镜，需要解剖

邸鲲 ：你多少倍的放大镜？直接手持的？

张金龙： 10倍的。珠宝鉴定用的，就很好 然后， 果实的类型/

邸鲲 ：10倍就都搞定了，可以啊。

张金龙： 浆果，核果， 翅果， 裂果，双悬果等等 果实的颜色和形状， 花为上位花， 下位花， 周位花

邸鲲 ：就是说如果要鉴定到种，还是需要花、叶、果什么的都齐全？

张金龙： 大部分是要叶，果齐全，或者叶 花齐全 否则大部分只能鉴定到属

邸鲲 ：明儿我淘宝上买个放大镜去。

张金龙： 当然，如果一个人对本地的植物特别熟悉看营养体认到种，也不无可能。 以上特征， 都看过了， 基本上就可以将植物确定到种了。其实都是植物形态学的基础 需要花很多时间去熟悉 之后， 才能认植物 否则是很难的

张金龙： 其中有几个特征，我觉得特别重要，特别是认营养体的时候

邸鲲 ：我感觉也是，你说的那些各种类型，我连定义好多都忘记了。另外，串种的几率貌似很大啊，以前植物实习时，采的标本老师直接晕了，说是两个杂交没法定了。

张金龙： 1 习性，如 木本， 草本，灌木， 藤本 2 叶片的类型和着生方式，单页， 复叶？ 三出？ 奇数偶数？ 对生， 互生， 轮生？ 3 叶片是否有锯齿 4 叶片叶柄结合处， 是否有关节 5 是否有托叶 6 果实的类型 因为很多时候， 看不到花 只能努力去多看一个地区内的大部分属， 科属， 用以上的特征， 就区分开来 不过还是要找感觉

邸鲲： 嗯哪，明白啦。唉，感觉最重要。

张金龙： ：每个科属， 记忆一到两个常见种 若干特殊种 比如 茜草科， 我们见到的绝大部分，

邸鲲 ：我觉得你应该是一看就知道是什么，如果需要详细的鉴别的话，才需要从上述的分类来仔细看，对吧。

张金龙： 都是叶全缘，轮生或对生。一看， 就说是什么种要么是专家， 要么是外行。 很厉害的人， 是不敢随便说是什么种的

邸鲲 ：啊，领教了。

张金龙： 一定要找到证据，也就是唯一符合该植物的特征。一定要能说出，为什么是这个植物， 才能说真正认识了

邸鲲 ：嗯，有点儿像是查案。

张金龙： 认植物不是记忆2000种， 3000种， 就是认识了。 关键是理解。 植物都是有规律的。

邸鲲 ：这个规律如何来把握呢？是从进化角度？

张金龙： 记忆属的特征 然后是科 然后 每个科， 每个属 都有自己喜好的生境 例如苦苣苔科植物一般都喜欢有流水的峭壁上，要求荫蔽， 湿润， 有些是按照属来归纳的，

邸鲲 ：就是把特征、习性等等多个方面来融会贯通。

张金龙： 例如杜鹃花属，多喜欢生在酸性的山顶鸢尾科植物， 多喜欢生在水边 百里香属植物， 喜欢生长在干旱的环境中 是的， 什么生境， 生长什么样的植物

邸鲲 ：你以前在北方上学的时候，对南方的植物如何来把握呢？我基本上就无视了。但是感觉你们好像对很多地区的植物都比较熟悉。

张金龙： 因为我需要去南方调查啊，对中国高等植物图鉴， 下了很大的功夫， 并且看了很多南方的植物志，如 贵州植物志， 广东植物志，海南植物志， 湖北植物志， 浙江植物志等 对关键特征做了笔记， 主要是记忆属的特征，争取在野外认到属， 之后就好查了。

邸鲲 ：真是下了不少功夫。相比之下，我基本上就没学吗。呵呵。

张金龙： 我准备整理一下，写一篇日志，说说如何认植物

邸鲲 ：嗯，好的。哈哈。我回头去拜读一下。 对了，再补充一下关于背诵植物拉丁名的问题。怎么背？

张金龙： 恩。我的经验是， 先要认识植物， 或者认识植物和记忆拉丁文同时， 植物的双名法当然需要先好好理解，其实主要是记忆属的拉丁文。属又分为阴性， 中性， 阳性的， 以 a或者ia结尾的， 多为阴性；以 um结尾的，多为中性； 以is， us结尾的，多为阳性。 然后种加词根据属名的性， 要做相应的变化。 种加词也都应该是表示所属的， 即所有格。种加词，一般取自植物采集的地点,如japonica，ussuriensis， mongolica, chinensis, orientalis， 植物的形态特征, hirsuta, acuta 颜色等等。 有时候为了纪念采集人， 多以采集人命名， 如 hancei，wangii 有专门的拉丁文词典， 解释植物拉丁文的意思。当然， 最好先学会植物拉丁文的发音规则，这样对于记忆植物拉丁文有很大的帮助。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49

sorted.boxplot <- function(x , factor.levels,  groups = NULL, ...){
    res <- tapply(x , factor.levels, FUN = mean)
    res.order <- as.character(10 * rank(res))    
    if(any(nchar(res.order)) > 3) {        
    stop("There are too many levels to sort!")

    }
    label3 <- label1 <- names(res)    
    for (i in 1:length(res.order)){        
    if( nchar(res.order[i]) == 2) {
          label3[i]  <- paste("0", res.order[i], sep = "")
        }    
        if( nchar(res.order[i]) == 3) {
          label3[i] <- paste(res.order[i], sep = "")
        }
    }
    lab.ref <- data.frame(label1, label3)
    label2 <- as.character(factor.levels)
    tab2 <- data.frame(label2)
    colnames(tab2) <- c("species")
    dat2 <- data.frame(x, factor.levels)
    colnames(dat2) <- c("Metric", "species")
    res.tab <- merge(x = dat2, y = lab.ref, 
        by.x = "species", by.y = "label1" , all = TRUE)
    res.tab$factors  <- paste(substring(as.character(res.tab$label3), 1, 2), 
                    res.tab$species, sep = " ")    
        if(!is.null(groups)){
        xxx <- sort(unique(res.tab$factors))
        tab.col <- data.frame(xxx, substring(xxx, 4, nchar(xxx)))
        colnames(tab.col) <- c("Sorted", "species")
        col.groups <- unique(data.frame(factor.levels,  groups))
        xxx2 <- merge(x = tab.col, y = col.groups, by.x = "species", by.y = "factor.levels")
        ressss <- xxx2[order(xxx2$Sorted), ]
        ressss$cols <- as.numeric(ressss$groups)

        colors.n <- topo.colors(length(unique(ressss$cols)))
        col.res <- data.frame(unique(ressss$cols), colors.n)
        colnames(col.res) <- c("level", "color")
        xxx3 <- merge(x = ressss, y = col.res, by.x = "cols", by.y = "level")
        xxx3 <- xxx3[order(xxx3$Sorted), ]
        boxplot(Metric ~ factors,  data = res.tab, col =  as.character(xxx3$color), ...)
        legend.dat <- unique(data.frame(xxx3$groups, xxx3$color))
        legend.label <- as.character(legend.dat[,1])
        legend.col <- as.character(legend.dat[,2])
        legend(length(xxx)/100, max(x), legend = legend.label, pch = 15, col = legend.col)
    } else {
        boxplot(Metric ~ factors,  data = res.tab, ...)
    }
}

函数的使用方法

1
2
3
4
5
6
7
8
9
10

a.value <- runif(100)  
## Generate Levels
a.levels <- sort(sample( LETTERS, 100, replace = TRUE)) 
## The levels for a factor
a.groups <- sort(sample(c("group1","group2","group3","group4"),100, replace = TRUE))  
## Group colors
par(las = 3, mar = c(10, 5, 5, 5))   
## Set the parameters for ploting device
sorted.boxplot(x = a.value , factor.levels = a.levels, 
    groups = a.groups, ylab = "Values", xlab = "Levels", main = "A sorted box plot")

物种按照数量性状聚类并且保存为树状图

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64

######### Generate a simulated data set ##########

trait1 <- runif(30)*8 + 15

trait2 <- runif(30)*500 + 2300

trait3 <- runif(30)*120 + 450

dat <- data.frame(trait1, trait2, trait3)

rownames(dat) <- paste("SP", 1:30, sep = "")

##############################

###################
### Rescale (standarization and centralization) all the columns
scaled.dat <- scale(dat)

## Euclidean Distance matrix for Trait1 
dist.trait1 <- dist(scaled.dat[,1])
dist.trait2 <- dist(scaled.dat[,2])
dist.trait3 <- dist(scaled.dat[,2])
dist.traits <- dist(scaled.dat)
## Hierachical clustering of the distance matrices, using UPGMA

hclust.trait1 <- hclust(dist.trait1, method = "average")
hclust.trait2 <- hclust(dist.trait2, method = "average")
hclust.trait3 <- hclust(dist.trait3, method = "average")
hclust.traits <- hclust(dist.traits, method = "average")

#### May not be displayed properly
par(mfrow = c(2, 2))
plot(hclust.trait1 )
plot(hclust.trait2 )
plot(hclust.trait3 )
plot(hclust.traits )


## Convert the hclust into dendrograms
dendro.trait1 <- as.dendrogram(hclust.trait1)
dendro.trait2 <- as.dendrogram(hclust.trait2)
dendro.trait3 <- as.dendrogram(hclust.trait3)
dendro.traits <- as.dendrogram(hclust.traits)

#### Plot the dendrogram #########
plot(dendro.trait1, horiz = TRUE)
plot(dendro.trait2, horiz = TRUE)
plot(dendro.trait3, horiz = TRUE)
plot(dendro.traits, horiz = TRUE)


#### Using APE package to convert the dendrograms to phylo, so that the "phylo" objects can be saved as newick tree files for subsequent analysis.
library(ape)
tree.trait1 <- as.phylo(hclust.trait1)
tree.trait2 <- as.phylo(hclust.trait2)
tree.trait3 <- as.phylo(hclust.trait3)
tree.trait4 <- as.phylo(hclust.traits)


#### Save the phylogenies to disk
write.tree(tree.trait1, "tree.trait1.tre")
write.tree(tree.trait2, "tree.trait2.tre")
write.tree(tree.trait3, "tree.trait3.tre")
write.tree(tree.trait4, "tree.trait4.tre")

以下是在瑞典的实验记录, 之前, 操作都是靠口授心传, 加上自己操作. 我将这些步骤详细记录下来. 
共分为: DNA提取(离心柱法), 浓度测定, DNA提取的电泳检验, PCR, PCR产物的凝胶电泳检验,毛细管电泳, 96孔板进行DNA提取以及检验等。全部内容, 均根据自己所做实验整理而成. 

实验一  用试剂盒提取植物的全DNA

目的：

从针叶或种子提取裸子植物全DNA，用于SSR，Barcoding等进一步分析。

准备：

1. 取冰。冰在UPSC 二楼049房间。 
2. 将Elution buffer 在65℃烘箱中预热。

操作步骤：

1. 每个待提取DNA样品取2枚针叶，在实验记录本上按照统一编号记录，并誊写样品标签上的所有信息。将2 mL圆底离心管按顺序编号，放在32孔板上。取约60mg针叶（Pinus sylvestris两针），剪碎（长宽不超过3mm），放入圆底离心管中。
2. 加入600μL SP1溶液，加入1μL RNase（在4℃冰箱中） 和 2粒瓷珠。
3. 在mixer mill上充分破碎，一般2min即可，若未打碎，继续破碎2min。
4. 将圆底离心管放在65℃ 金属浴，10min － 15min ，中间混合1－2次。
5. 加入210μL SP2，放冰上5min。
6. 14000rpm离心，5min。
7. 取上清液到绿柱子，12000rpm，1min （对于种子，步骤可以省略）
8. 将上清液移到2mL新的圆底离心管，加入1.5倍体积的SP3（一般为500 － 700μL），混合均匀。
9. 将700μL上清液转移到蓝柱子（放在新的无盖离心管中，注意柱子和离心管都要标号）， 12000rpm， 1min，倒掉离心管下的液体。
10. 将第8步剩余的上清液继续转移到蓝柱子，12000rpm，1min，倒掉离心管下的液体。
11. 加入500μL的Washing Buffer到蓝柱子，12000rpm，1min，倒掉离心管下的液体。
12. 重复第11步。
13. 将蓝柱子放回原离心管离心，14000rpm，2min。
14. 取干净的EP管，标号。将蓝柱子放入干净的EP 管中，加入90μL 65℃ Elution Buffer洗脱，等候约4min， 12000rpm， 离心1min。
15. 丢弃蓝柱子，将EP管（下面的溶液即为提好的DNA）贴好标签，写上实验纪录上的编号，放入4℃冰箱保存。
    如果为种子：
    发芽至外露1－2cm，除去种皮， 整粒种子放入2mL圆底离心管。以下程序同。 最后洗脱用100μL Elution Buffer。若需要洗脱完全，则考虑用50μL进行第二次洗脱。

实验二 DNA样品的琼脂糖凝胶电泳检测

目的

用琼脂糖凝胶电泳检测DNA提取是否成功

准备：烘箱65℃，打开

操作步骤：

1. 在电子天平上称取1.2g琼脂糖，放入锥形瓶。
2. 用量筒量取120mLTBE溶液，倒入锥形瓶。
3. 将锥形瓶在微波炉中加热三分钟，在沸腾后，轻摇几次，使得琼脂糖全部溶化。
4. 放在常温冷却，待65℃左右，（至外边仍然比较烫手，但没有蒸气散出时）。加入8μL  EB（溴化乙锭），摇匀。
5. 将胶槽两端用不干胶封好，倒入30mL左右的溶液，插入胶孔成型用的梳子，待15到20分钟冷凝。将锥形瓶用多层保鲜膜盖好，并用铝箔封口，放在65℃的烘箱中。
6. 点 Loading Buffer。每一次取10μL的红色Loading Buffer，分成五份，每个约两μL，点在事先固定在tip盒盖的石蜡膜上。按照样品的数量，点出相应数量的Loading Buffer水珠。
7. 点Lambda标准样（试剂公司合成的特定浓度的DNA样品），2μL，若是两排胶孔，应该点两个Lambda标准样。
8. 吸取DNA样品，每个吸取2μL，为防止DNA样品的污染，每一次都要换枪头。按照次序点入Loading Buffer水珠中。
9. 将胶放置在电泳槽中，令电泳液将其浸入。注意，胶孔一端要放在负极（黑色电极）一端。
10. 点样，先在最左侧的胶孔中点入lambda样，将移液器的量程调至4－5μL，按照顺序，吸取水珠，点入胶孔中，此时不必每一次都换枪头。
11. 将电泳仪电压调到80－110V之间，电泳15分钟。
12. 取胶：先关闭电源，戴上蓝色在Techtum Lab AB凝胶成像系统中拍照。拍照时用MVPILOT软件，点击摄像机的图标，调整对比度和明暗效果，在左侧MITSUBISHI打印机上打印。保存图像时，点击照相机的图标。
13. 完成拍照后，将凝胶丢弃，仪器擦拭干净，并保持Techtum Lab AB的门打开。

实验三 用Nanodrop检测DNA浓度

目的：

Nanodrop分光光度计测量提取的DNA浓度

操作步骤：

1. 双击打开Nanodrop管理界面，点击Nucleic Acid Measurement。将Nanodrop的探测器旋臂抬起，用蒸馏水擦拭干净。
2. 用移液器吸取1μL 双蒸水（量程可调至1.2μL），点在探头上，盖好，点击Initialize按钮。
3. 打开探测器旋臂，用移液器点一滴Elution Buffer（这是由于之前用的是Elution Buffer，待测的DNA溶于什么溶液，就应该用相应的溶液作为本底对照），点击Blank按钮
4. 抬起旋臂，擦拭干净，换枪头，吸取1.2μL的待测样品，点Measure按钮，记录右下角的DNA浓度。
5. 依次重复步骤4，直至所有样品的浓度都测定完。

实验四 PCR 反应

步骤：

1. 将引物成对摆放，9对引物一定要两两放在一起，并排号。在冰板上，放置9个 ep排管，用以9个不同的引物体系。因每排管由8个小ep管组成，每个96孔板上只能做8个DNA样品（8 *9 ＝ 72组合）。
2. 将待检测模板DNA用ddH2O稀释到10ng /uL ，贴上标签，放在4℃保存。
3. 按照DNA样品的数量，计算每对引物各组分的体积。每个组分扩大的倍数，取决于模板DNA的数目（实际情况下的体系的体积倍数要比DNA的数量稍多，每个1.5mL 的ep管内各组分需要到达足够的体积，才能准确量取以及混合）。
4. 取9个1.5mL的ep管，分别按照顺序，添加表1中除DNA模板外的组分。 

表1 16uL  PCR反应体系

1
2
3
4
5
6
7
8
9
10

order    Constituents    Storage    Volume Per PCR Tube    ×
1    ddH2O    RT                    11.85uL    uL
2    PCR buffer 10×    4℃                      1.6uL    uL
3    dNTP (25mM/uL)    4℃    0.1uL    (0.156mM)    uL  
4    Ordinary Primer (10uM)    4℃    0.2uL     (0.125uM)    uL
5    With Dye Primer (10uM)    4℃    0.2uL     (0.125uM)    uL
6    TopTaq (5 Unit/uL)    －20℃    0.05uL     (0.25unit)    uL
    分装到各ep管，每管14uL            
7    DNA template         2uL       (10-20ng)    每个样品吸取2uL 模板DNA
     Total        16uL    

5. 将混合好的体系，按照行，分装到同一排管的小ep管中，每个14uL。
6. 从稀释过的DNA（约10ng/uL），吸取2uL，按照列，添加到排管的小ep管中。
7. 手动混合反应体系，离心。 按照所需退火温度不同，分成三组： 
       1. 第一组 LOP1和SsrPt_ctg4363，touch down 温度为 64 – 54℃
       2. 第二组 PtTx3107和PtTX4001，touch down 温度为55－45℃
       3. 第三组PtTX2146，PtTX3025，PtTX3116，SsrPt_ctg1376, SPAC12.5，touch down为60－50℃。
8. 每个PCR反应耗时约2－2.5h。注意，PCR仪在最后的延伸完成后，会降到15℃，应该尽快将产物转移到4℃冰箱中， 并尽快检测。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21

Table 2. Primers and PCR conditions for each locus (Part I) version 0.3
ID    1    2    3    4    5
Locus    LOP1    PtTX2146    PtTX3025    PtTX3107    PtTX3116
Dye    Cy5.5 green    D2 Black    D2 Black    D2 Black    Cy5 Blue
Forward(5-3)    GGCTAATGGCCGGCCAGTGCT    CCTGGGGATTTGGATTGGGTATTTG    CACGCTGTATAATAACAATCTA    AAACAAGCCCACATCGTCAATC    CCTCCCAAAGCCTAAAGAAT
Reverse(5-3)    GCGATTACAGGGTTGCAGCCT    ATATTTTCCTTGCCCCTTCCAGACA    TTCTATATTCGCTTTTAGTTTC    TCCCCTGGATCTGAGGA    CATACAAGGCCTTATCTTACAGAA
Ta    Touch down 64-54°C    Touch down 60-50°C    Touch down 60-50°C    Touch down 55-45°C    Touch down 60-50°C
size range    153-189    176-264    211-305    150-174    115-169
PCR Conditions                         
1    94 °C 3min initial denaturation    94 °C 3min initial denaturation    94 °C 3min initial denaturation    94 °C 3min initial denaturation    94 °C 3min initial denaturation
18 cycles    2    94 °C  30s    94 °C  30s    94 °C  30s    94 °C  30s    94 °C  30s
    3    30 S from 64 °C to 54 °C  decrease 0.6 per cycle    30 S from 60 °C to 50 °C  decrease 0.6 per cycle    30 S from 60 °C to 50 °C  decrease 0.6 per cycle    30 S from 55°C to 45 °C  decrease 0.6 per cycle    30 S from 60 °C to 50 °C  decrease 0.6 per cycle
    4    72 °C 30S      72 °C 30S      72 °C 30S      72 °C 30S      72 °C 30S  
                          
25
cycles    5    94 °C 30s     94 °C 30s     94 °C 30s     94 °C 30s     94 °C 30s 
    6    54 °C 30s    50 °C 30s    50 °C 30s    45 °C 30s    50 °C 30s
    7    72 °C 30s    72 °C 30s    72 °C 30s    72 °C 30s    72 °C 30s
                          
Final   extention  8    72°C 10 min    72°C 10 min    72°C 10 min    72°C 10 min    72°C 10 min
Preservation    15°C --    15°C --    15°C --    15°C --    15°C --

                    Date: 2012-3-13
       Jinlong                                                                                    

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22

Table 2. Primers and PCR conditions for each locus (Part II) version 0.3
ID    6    7    8    9
Locus    PtTX4001    SsrPt_ctg1376    SsrPt_ctg4363    SPAC12.5
Dye    Cy5  Blue    Cy5.5 Green    Cy5  Blue    Cy5.5 Green
Forward(5-3)    CTATTTGAGTTAAGAAGGGAGTC    CGATATTATGGATTTTGCTTGTGA    TAATAATTCAAGCCACCCCG    CTTCTTCACTAGTTTCCTTTGG
Reverse(5-3)    CTGTGGGTAGCATCATC    AAATGCATGCCAAACTTAAATAC    AGCAGGCTAATAACAACACGC    TTGGTTATAGGCATAGATTGC
Ta    Touch down 55-45°C    Touch down 60-50°C    Touch down 64-54°C    Touch down 60-50°C
size range    198-229    88-124    95-106    118-184
PCR Conditions                    
1    94 °C 3min initial denaturation    94 °C 3min initial denaturation    94 °C 3min initial denaturation    94 °C 3min initial denaturation
18 cycles    2    94 °C  30s     94 °C  30s     94 °C  30s     94 °C  30s 
    3    30 S from 55°C to 45 °C decrease 0.6 per cycle    30 S from 60 °C to 50 °C  decrease 0.6 per cycle    30 S from 64 °C to 54 °C  decrease 0.6 per cycle    30 S from 60 °C to 50 °C  decrease 0.6 per cycle
    4    72 °C 30S      72 °C 30S      72 °C 30S      72 °C 30S  
                     
25
cycles    5    94 °C 30s     94 °C 30s     94 °C 30s     94 °C 30s 
    6    45 °C 30s    50 °C 30s    54 °C 30s    50 °C 30s
    7    72 °C 30s    72 °C 30s    72 °C 30s    72 °C 30s
                     
Final 
extention       8    72°C 10 min    72°C 10 min    72°C 10 min    72°C 10 min
Preservation    15°C --    15°C --    15°C --    15°C --

                                             Date: 2012-3-13
                                                  Jinlong

实验五 PCR产物的检测

步骤：

一 治胶

1. 在电子天平上称取1.2g琼脂糖，放入锥形瓶。
2. 用量筒量取120mLTBE溶液，倒入锥形瓶。
3. 将锥形瓶在微波炉中加热三分钟，在沸腾后，轻摇几次，使得琼脂糖全部溶化。
4. 放在常温冷却，待65℃左右，（至外边仍然比较烫手，但没有蒸气散出时）。加入0.8μL  EB（溴化乙锭），摇匀。
     1 － 4 仅适用于首次做胶时参考。
5. 将胶槽两端用不干胶封好，倒入30mL左右的溶液，插入胶孔成型用的梳子，待15到20min冷凝。将盛有剩余溶胶的锥形瓶用多层保鲜膜盖好，并用铝箔封口，放在65℃的烘箱中。

   二 点样

6. 点 Loading Buffer。每一次取10μL的红色Loading Buffer，分成五份，每个约2μL，点在事先固定在tip盒盖的石蜡膜上。按照样品的数量，点出相应数量的Loading Buffer水珠。
7. 点Ladder DNA标准样，5μL，若是两排胶孔，应该点Ladder DNA标准样。
8. 吸取DNA样品，每个吸取4μL，为防止DNA样品的污染，每一次都要换枪头。按照次序点入Loading Buffer的水珠中。
9. 将胶放置在电泳槽中，令电泳液将其浸入。注意，胶孔一端要放在负极（黑色电极）一端。
10. 点样，先在最左侧的胶孔中点入lambda样，将移液器的量程调至4－5μL，按照顺序，吸取水珠，点入胶孔中，此时不必每一次都换枪头。

    三 电泳

11. 将电泳仪电压调到80－110V之间，电泳15分钟。

    四 紫外光检测

12. 取胶：先关闭电源，戴上蓝色在Techtum Lab AB凝胶成像系统中拍照。拍照时用MVPILOT软件，点击摄像机的图标，调整对比度和明暗效果，在左侧MITSUBISHI打印机上打印。保存图像时，点击照相机的图标。
13. 完成拍照后，将凝胶丢弃，仪器擦拭干净，并保持Techtum Lab AB的门打开。

实验六 用96孔板提取Scots Pine种子DNA

准备：

SP1 在使用前，每200μL加入1uL的RNAse， 如研磨2×96材料，则取SP1 40mL，加入200uLRNAse。 放在65℃烘箱预热。
Elution Buffer 65℃预热

步骤：

1. 取96孔板，每个孔放1颗瓷珠，1粒Scots Pine种子，盖好。
2. 充分研磨破碎1min，在UPSC 6th floor。3700rpm离心1，使碎片落入管底，继续破碎1min。
3. 开盖加入200μL  SP1，放65℃ 烘箱中10min，混匀两次，将壁上的液体离心到底部（2000rpm）
4. 加入70μL SP2，盖好，混匀，短离心，
5. 放入-20℃冰箱 10min
6. 3700rpm 离心10min
7. 将上清液移动到1.2mL管中（约200μL）
8. 加入1.5体积的SP3 （约300μL）
9. 盖好，混匀20s， 短离心（到3000rpm）
10. 将柱子板放方孔底座上，每孔加入150μL Equilibration Buffer， 混匀，静置4min， 3000rpm离心 2min
11. 每个管中取500μL样品移到 HiBind DNA柱子板上，置于方孔底座上。
12. 盖好尼龙膜，3700rpm离心 3min。
13. 去掉尼龙膜，倒掉方孔底座中的液体。
14. 加入800μL SPW Wash Buffer， 盖好尼龙膜， 3700离心3min，倒掉方孔底座中的液体。
15. 加入800μL SPW Wash Buffer， 3700离心5min，倒掉方孔底座中的液体，再离心10min，以彻底去掉乙醇，倒掉方孔底座中的液体。放在通风厨10分钟，晾干。
16. 将柱子板放在1.2mL排管上，用100μL 65℃ 预热的Elution Buffer洗脱。在65℃温箱中静置5min。 3700rpm离心 5min。
17. 1.2mL排管盖好，保存在4℃冰箱中，其余丢弃。
    对DNA进行常规琼脂糖凝胶电泳检测， 2uLDNA， lambda标准样 2uL

20120329

实验七 96孔板PCR

1. 稀释模板DNA
           将提取到的总 DNA 吸取到96孔板上，根据Nanodrop对DNA的测量结果，用ddH2O稀释到10-20ng/uL，需要根据PCR的次数和每次DNA样品量确定要吸 取的DNA量，保证取样量至少多15uL以上。作为模板DNA，写清楚模板DNA的序号，日期，标签如下 Plate-I，放在4°C保存。
2. 准备模板标签
        对于96孔板，每一格填写如下信息： 1 序号（1-96，一般按照列保存）  2 DNA序列号（如E4218） 3 树编号 （UID，即每棵树所取的哪颗种子  如 81-8，表示81号树的第8颗种子）。
3. 模板DNA取样
       用排枪取2μL的模板DNA，加入到到96孔板管底部。由于不带有荧光，模板DNA的枪头可收集起来，可以作为毛细管电泳时混合样品用的枪头，但是要做好标记。
4. 混合反应体系 Master Mix

   1 2 3 4 5 6 7

   No.    Conponent    Volume per tube    Concentration    ×25    Storage 1    ddH2O     10.95    -    273.75    RT 2    10×PCR buffer    1.6    -    40    -4°C 3    2.5mM dNTP    1    0.15625    25    -4°C 4    Forward Primer    0.2    0.125    5    -4°C 5    Reverse Primer    0.2    0.125    5    -4°C 6    Top Taq    0.05    2.5U    1.25    -20°C

   对于任意一板的PCR反应，需要准备4个1.5mL的ep管，先放在冰盒上，按照1-6的顺序添加各组分到ep管中。盖好盖子，短离心，涡旋，短离心，确保体系混合均匀。
5. 用电子移液器（该移液器每次可吸取100μL，由于需要加入的反应体系是14μL，因此只能加7次，注意第一次吸取的液体要打掉，长音表明是最后一次），吸取反应体系，每管加入14μL。
6. 在96孔板的边缘标记好Plate号，引物名称等，之后贴Bio-Rad的PCR厚膜，用手柄压实，确保每一管的封口都严密。
7. 在振荡器上涡旋4-5下，确保反应体系和模板DNA充分混合。短离心，达到2000rpm以上。
8. 按照如下条件，设定touch down PCR:

   1 2 3 4 5

   Tab.1 LOP1          TD 64 to 54       Tab. 2 PtTX2146        TD 60 to 50 Tab.3 PtTX3025      TD 55 to 45       Tab. 4 PtTX3107        TD 55 to 45 Tab.5 PtTX3116      TD 60 to 50       Tab. 6 PtTX4001        TD 60 to 50 Tab.7 SsrPt_ctg1376 TD 60 to 50       Tab. 8 SsrPt_ctg4363   TD 64 to 54 Tab.9 SPAC12.5      TD 55 to 45

9. 每个PCR需要耗时2.5h左右。反应结束后，将产物放到4°C冰箱中保存。
10. 对产物进行琼脂糖凝胶电泳检测，一般每板随机抽检16个样品，点样的量一般为： 
          Loading Buffer     2.5 μL
          PCR产物              3μL
          Ladder DNA         5μL

实验七96孔板PCR

1. 稀释模板DNA
           将提取到的总 DNA 吸取到96孔板上，根据Nanodrop对DNA的测量结果，用ddH2O稀释到10-20ng/uL，需要根据PCR的次数和每次DNA样品量确定要吸 取的DNA量，保证取样量至少多15uL以上。作为模板DNA，写清楚模板DNA的序号，日期，标签如下 Plate-I，放在4°C保存。
2. 准备模板标签
        对于96孔板，每一格填写如下信息： 1 序号（1-96，一般按照列保存）  2 DNA序列号（如E4218） 3 树编号 （UID，即每棵树所取的哪颗种子  如 81-8，表示81号树的第8颗种子）。
3. 模板DNA取样
       用排枪取2μL的模板DNA，加入到到96孔板管底部。由于不带有荧光，模板DNA的枪头可收集起来，可以作为毛细管电泳时混合样品用的枪头，但是要做好标记。
4. 混合反应体系 Master Mix

1
2
3
4
5
6
7

No.    Conponent    Volume per tube    Concentration    ×25    Storage
1    ddH2O     10.95    -    273.75    RT
2    10×PCR buffer    1.6    -    40    -4°C
3    2.5mM dNTP    1    0.15625    25    -4°C
4    Forward Primer    0.2    0.125    5    -4°C
5    Reverse Primer    0.2    0.125    5    -4°C
6    Top Taq    0.05    2.5U    1.25    -20°C

         对于任意一板的PCR反应，需要准备4个1.5mL的ep管，先放在冰盒上，按照1-6的顺序添加各组分到ep管中。盖好盖子，短离心，涡旋，短离心，确保体系混合均匀。

1. 用电子移液器（该移液器每次可吸取100μL，由于需要加入的反应体系是14μL，因此只能加7次，注意第一次吸取的液体要打掉，长音表明是最后一次），吸取反应体系，每管加入14μL。

2. 在96孔板的边缘标记好Plate号，引物名称等，之后贴Bio-Rad的PCR厚膜，用手柄压实，确保每一管的封口都严密。

3. 在振荡器上涡旋4-5下，确保反应体系和模板DNA充分混合。短离心，达到2000rpm以上。

4. 按照如下条件，设定touch down PCR:

   1 2 3 4 5

   Tab.1 LOP1          TD 64 to 54       Tab. 2 PtTX2146        TD 60 to 50 Tab.3 PtTX3025      TD 55 to 45       Tab. 4 PtTX3107        TD 55 to 45 Tab.5 PtTX3116      TD 60 to 50       Tab. 6 PtTX4001        TD 60 to 50 Tab.7 SsrPt_ctg1376 TD 60 to 50       Tab. 8 SsrPt_ctg4363   TD 64 to 54 Tab.9 SPAC12.5      TD 55 to 45

5. 每个PCR需要耗时2.5h左右。反应结束后，将产物放到4°C冰箱中保存。

6. 对产物进行琼脂糖凝胶电泳检测，一般每板随机抽检16个样品，点样的量一般为： 
         Loading Buffer     2.5 μL
         PCR产物              3μL
         Ladder DNA         5μL

实验八 在CEQ 8000上进行毛细管电泳

一   准备Excel 作为样品的Label
每一板混合样的侧面，应该用记号笔标注清楚 ，例如2012-03-29-Plate-I-a
标签 文件，应该保存在Excel中，待毛细管电泳时，直接拷贝到CEQ8000的界面中。
表 2 96孔板标签的排列

1
2
3
4
5
6
7
8
9

     1    2    3    4    5    6    7    8    9    10    11    12
A    69-1-a    69-2-a    69-3-a    69-4-a    69-5-a    69-6-a    69-7-a    69-8-a    69-9-a    69-10-a    69-11-a    143-4-a
B    71-1-a    71-2-a    71-3-a    71-4-a    143-1-a    143-2-a    71-7-a    71-8-a    143-3-a    71-10-a    71-11-a    71-12-a
C    73-1-a    73-2-a    73-3-a    73-4-a    73-5-a    73-6-a    73-7-a    73-8-a    73-9-a    73-10-a    73-11-a    73-12-a
D    74-1-a    74-2-a    74-3-a    74-4-a    74-5-a    74-6-a    74-7-a    74-8-a    74-9-a    74-10-a    74-11-a    74-12-a
E    81-1-a    81-2-a    81-3-a    81-4-a    81-5-a    81-6-a    81-7-a    81-8-a    81-9-a    81-10-a    81-11-a    81-12-a
F    82-1-a    82-2-a    82-3-a    82-4-a    82-5-a    82-6-a    82-7-a    82-8-a    82-9-a    82-10-a    82-11-a    82-12-a
G    84-1-a    84-2-a    84-3-a    84-4-a    84-5-a    84-6-a    84-7-a    84-8-a    84-9-a    84-10-a    84-11-a    84-12-a
H    86-1-a    86-2-a    86-3-a    86-4-a    86-5-a    86-6-a    86-7-a    86-8-a    86-9-a    86-10-a    86-11-a    86-12-a

二 待检 样品的混合

1. 取96孔上样板和PCR中吸取过DNA的10μL枪头。
2. 按照顺序排好PCR产物，按照以下量, 用10uL排枪分组添加如下产物到管底部。 注意，每个上样板都由三种产物混合，每次DNA吸取后，都要换枪头。

1
2
3
4
5
6
7
8
9
10
11
12
13

 Table 1 Information for the labeld primers
Primer    Label    PCR frag length    Color    Group    Volume (uL)
SsrPt_ctg1376    Cy5.5    88-124    Green    1 a    2
PtTX4001    Cy5    198-229    Blue    1 a    0.5
PtTX3107    D2    150-174    Black    1 a    4.5
                    
SPAC12.5    Cy5.5    118-184    Green    2 b    2
SsrPt?_ctg4363    Cy5    95-106    Blue    2 b    0.5
PtTX3025    D2    211-305    Black    2 b    4.5
                    
LOP1    Cy5.5    153-189    Green    3 c    2
PtTX3116    Cy5    115-169    Blue    3 c    0.5
PtTX2146    D2    176-264    Black    3 c    4.5

1. 取塑料纸盒，一般每板需要两个2mL ep管的HD，倒入纸盒内。取黄色枪头，每一管，加入30uL 已经混合好的Hi-Di (HD)，无需换枪头。
2. 用新的黄枪头，将每一列孔的样品反复吸放几次，以混合均匀。 贴96孔板塑料膜。
3. 短离心到2000rpm。
4. 如有必要，每个孔滴入染料包内附带的一滴矿物油，防止样品蒸发。

   二  准备Separation Buffer板

   地点：UPSC ，B3-28-48
5. 取Buffer取样槽，倒入已经稀释好的Separation buffer，用电子排枪每个Separation buffer板孔中放入250uL的separation buffer。 确认无误后，将剩余Separationbuffer倒回瓶内。用双蒸水冲洗Buffer取样槽，用吸水纸擦干，放回原处。
6. 取PAGE胶（在4°C冰箱），形如注射器，注意要事先将包装剪开。

   三  从CEQ 8000中拷贝上一次运行的数据

   1. 双击打开CEQ >CEQ Main > Database(屏幕正下方中央倒数第五个图标)
              在新开启的窗口下的导航栏中，选择对应的文件夹(Jinlong), 点击右键，选择 set as working database.
   2. 回到Jinlong 用户下，选择Default > Sample Data> ，在右侧显示的窗口中，将文件按照时间排序。
   3. 选择要导出的文件，右键export，选择scf作为导出格式。
   4. 将导出的文件拷贝到桌面Jinlong 文件夹中，新建一个文件夹，命名按照如下规则
      例如:
      2012-03-27-Plate-I-a （a表示第一组， 即SsrPt_ctg1376,  PtTX4001和PtTX3107的混合样）
      2012-03-28-Plate-I-b （b 表示第二组， 即SPAC12.5, SsrPt_ctg4363和PtTX3025的混合样）
      2012-03-29-Plate-I-c  （c表示第三组，即LOP1, PtTX3116 和PtTX2146的混合样）
      2012-03-29 即日期 2012年3月29日
      Plate-I 表示是第一板DNA的扩增产物。
   5.   将整个文件夹拷贝到USB Flash Disk中。

五 上样及运行：

注意： 一定要按照CEQ8000操作系统中的提示，换Separation Buffer， DNA sample 及 Wetting Tray， Gel Catridge。

1. 打开CEQ > CEQ Main > Database (屏幕正下方工具栏的倒数第五个图标) > 选择Jinlong>右键 set as working database
2. 洗Wetting tray。点击工具栏的Run图标，在新界面的菜单中，点击Replenish> Replenish wetting tray，提示 Do you want to replesh the wetting tray? 点OK。当出现上面的对话框显示为绿色时，可以打开上盖，wetting tray两端的卡子，取下Wetting tray， 打开后，倒掉里面的水及胶的混合液，用双蒸水冲洗。擦干后放回。
3. 安装样品，在里面的支架上放样品，放好后再揭开贴膜，在外面的支架上放separation buffer，盖好separation buffer板的盖子, 点Done。
4. 如果之前已经将胶卸载，并安装了黄色的Plug，则必须要从 Install gel catridge开始（Release gel catridge为灰色）。点击Install gel catridge，稍等几分钟后，“没有胶或者胶已经泄露”等信息，点击release gel。如果前面的胶未卸载，则直接点击Release gel catridge即可换下前面剩余的胶柱在注射器中。
5. 若提示 “Do you wish to release the gel cartridge?”,点OK。待出现“you may now open gel access and change gel catridge”的对话框，则可以打开下面的盖子，卸下已经安装好的黄色塞子（plug），将盛满胶的注射器的安装好。点击 Replenish>Install gel catridge,等待新胶柱安装好。
6. 用Direct control打出一些胶，目的是防止胶柱前端的空气进入毛细管中。一般需挤出为0.2mL路径： 菜单 >Direct control > Manifold Purge > 输入0.2mL即可。
7. 在屏幕正下方的控制界面中，点击Sample setup（工具条第一个），选择Create a new sample，从excel中拷贝96孔板的样品标签。
       在出现的表格中，将96孔板的名称标签粘贴到两个view中（在页面最上面的check point）。第一个界面，每一列的最下方，都要选取Frag3，两个页面核对无误后保存，文件名参照统一命名格式 如 2012-03-29-Plate-I-a。表格将从白色变成蓝色。
8. 点击右上角的Run sample Plate 
           若出现对话框  Capillary Array usage exceeded. Do you want to continue? 选择 Yes
           Select a sample plate to Run，选择刚刚保存的2012-03-29-Plate-I-a，
9. 新弹出的屏幕左侧显示的是Buffer，右侧显示样品，高亮部分表明该板对应位置应该有样品和缓冲液。点击左下角的 Start开始进行毛细管电泳。
10. 样品完成后的卸载和塞子安装。96孔板的毛细管电泳大约耗时10h，注意查看Log文件。全部结束后，冲洗wetting tray， Replesh > Replesh wetting tray, 冲洗好后，放回。点击Replenish > Release gel catridge , 提示 “Do you wish to release the gel catridge?” 点OK,等待1 – 2min， 胶柱卸载。
11. 换下用过的多半管胶，塞入黄色的塞子（Plug In），关好门后，显示点击 Replenish>Install Gel catridge 出现对话框，Install Plug In. 将没用用过的胶放回4°C冰箱保存。 

请参阅

http://blog.sciencenet.cn/blog-255662-849868.html

https://github.com/helixcn/herblabel

使用 herblabel程序包生成植物标本采集标签。

早在2006年， 一起和同门的陈彬博士在云南出野外时， 陈博士就提供了一个打印植物采集标签的Excel小程序。 因为我当时完全不懂编程， 觉得很神奇， 程序虽然很小，但是确实提供了很多方便。

进入嘉道理农场工作以来， 我的工作包括采集标本。 从采集记录快速生成采集标签的需求又一次摆在我面前。 但是陈彬博士提供的excel程序各部分都是中文， 但是我需要输入英文， 标签的格式也要进行相应的调整。 基于他提供的VBA程序， 我对VBA的源代码进行了修改， 调整了输出标签的格式，以及字体， 每一行的大小， 以及插入分隔符的位置等。

实现的功能
输入 在sheet1中按照要求相应的采集信息， 执行本命令， 例如用按钮关联，在sheet2中就可以生成固定的标签。

以下是Excel VBA中的源代码。 供感兴趣的读者参考， 并欢迎提出宝贵意见。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162

 ''#########################################################################
''########## This macro was developed Dr. JinlongZhang  base on ##########
''################# a  VBA macro by Dr.  Bin Chen #########################
''################# Email : jinlongzhang01@gmail.com ####################
''#########################  30/01/2013 ###################################
''#########################################################################
Dim a, b, c, d,e, f, g As Integer  'Definition of the variables
'Maximum Number of labels can be created
'b
Sheet2.Columns.Clear
Sheet2.ResetAllPageBreaks
Sheet2.DisplayPageBreaks = False
c = 1                               '
d = 0
For a = 2 To 50000
   If Sheet1.Cells(a, 1) = "" Then
      MsgBox "Please find the labels in Sheet 2"
       Exit For
   Else
       g =Sheet1.Cells(a, 16)   ' Numberof copies for one collection number
       For b = 1 To g
            If d > 1 And (d Mod 8 = 0 Or d Mod 8 = 1) Then 'A justing the margins, and number of labels per page.
              f = 13
            Else
              f = 14
            End If
        If d > 1 And (d Mod 2 = 0) Then
           c = c + f
       End If
           e = (d + 1) Mod 2
If e = 1 Then
  Sheet2.Cells(c, 1) = TextBox1.Text
  Sheet2.Cells(c + 1, 1) = TextBox2.Text
  Sheet2.Cells(c + 2, 1) = Sheet1.Cells(a, 4) '"Species: "
  Sheet2.Cells(c + 3, 1) = Sheet1.Cells(a, 5) ' "Infraspecies: "
  Sheet2.Cells(c + 4, 1) = "Family: " +Sheet1.Cells(a, 8)
  Sheet2.Cells(c + 5, 1) = "Local Name: " +Sheet1.Cells(a, 6)
  Sheet2.Cells(c + 6, 1) = "Field Note: " +Sheet1.Cells(a, 9)
  Sheet2.Cells(c + 7, 1) = "Locality: " +Sheet1.Cells(a, 17)
  Sheet2.Cells(c + 8, 1) = "Lon/Lat/Alt: " +Sheet1.Cells(a, 18) + "/" +Sheet1.Cells(a, 19) + "/" +Sheet1.Cells(a, 20) + "m"
  Sheet2.Cells(c + 9, 1) = "Col. & Num: " + Sheet1.Cells(a, 2) + " " +Sheet1.Cells(a, 1)
  Sheet2.Cells(c + 10, 1) = "Date Col.: " +Sheet1.Cells(a, 3)
  Sheet2.Cells(c + 11, 1) = "Det. & Date: " + Sheet1.Cells(a, 24) + "/" +Sheet1.Cells(a, 25)
  Sheet2.Cells(c + 12, 1) = "Note: " +Sheet1.Cells(a, 13)
   With Sheet2  'applicaton    ' Adjusting the display of the text
       'Set height for rows
       .Range(.Cells(c,1), .Cells(c+ 12, 1)).RowHeight = 12
       'Set width for columns
       .Range(.Cells(c,1), .Cells(c+ 12, 1)).ColumnWidth = 42
       .Range(.Cells(c,1), .Cells(c+ 12, 1)).Font.Name = "Arial"
       .Range(.Cells(c,1), .Cells(c+ 12, 1)).Font.Size = 11       'Size
       .Range(.Cells(c,1), .Cells(c+ 12, 1)).HorizontalAlignment = xlGeneral
       .Range(.Cells(c,1), .Cells(c+ 12, 1)).VerticalAlignment = xlCenter
       .Range(.Cells(c,1), .Cells(c+ 12, 1)).WrapText = False
       .Range(.Cells(c,1), .Cells(c+ 12, 1)).Orientation = 0
       .Range(.Cells(c,1), .Cells(c+ 12, 1)).AddIndent = False
       .Range(.Cells(c,1), .Cells(c+ 12, 1)).IndentLevel = 0
       .Range(.Cells(c,1), .Cells(c+ 12, 1)).ShrinkToFit = True
       .Range(.Cells(c,1), .Cells(c+ 12, 1)).ReadingOrder = xlContext
       .Range(.Cells(c,1), .Cells(c+ 12, 1)).MergeCells = False
   End With
   With Sheet2.Cells(c, 1)  'Adjusting the Title, right
       .Font.Name= "Arial" 'Font
       .Font.Size= 12     'Size
       .Font.Bold= True   'Alignment
       .HorizontalAlignment= xlCenter
       .VerticalAlignment= xlCenter
       .WrapText= False
       .Orientation= 0
       .AddIndent= False
       .IndentLevel= 0
       .ShrinkToFit= True
       .ReadingOrder= xlContext
       .MergeCells= False
   End With
   With Sheet2.Cells(c + 1, 1)   ' Formatthe subtitle
       .HorizontalAlignment= xlCenter
       .VerticalAlignment= xlCenter
       .Font.Name= "Times New Roman" 'Font
       .Font.Size= 12     'Size
   End With
ElseIf e = 0 Then
  Sheet2.Cells(c, 2) = TextBox1.Text          'Title
  Sheet2.Cells(c + 1, 2) = TextBox2.Text      'Subtitle
  Sheet2.Cells(c + 2, 2) = Sheet1.Cells(a, 4) '"Species: "
  Sheet2.Cells(c + 3, 2) = Sheet1.Cells(a, 5) ' "Infraspecies: "
  Sheet2.Cells(c + 4, 2) = "Family: " +Sheet1.Cells(a, 8)
  Sheet2.Cells(c + 5, 2) = "Local Name: " +Sheet1.Cells(a, 6)
  Sheet2.Cells(c + 6, 2) = "Field Note: " +Sheet1.Cells(a, 9)
  Sheet2.Cells(c + 7, 2) = "Locality: " +Sheet1.Cells(a, 17)
  Sheet2.Cells(c + 8, 2) = "Lon/Lat/Alt: " +Sheet1.Cells(a, 18) + "/" +Sheet1.Cells(a, 19) + "/" +Sheet1.Cells(a, 20) + "m"
  Sheet2.Cells(c + 9, 2) = "Col. & Num: " + Sheet1.Cells(a, 2) + " " +Sheet1.Cells(a, 1)
  Sheet2.Cells(c + 10, 2) = "Date Col.: " +Sheet1.Cells(a, 3)
  Sheet2.Cells(c + 11, 2) = "Det. & Date: " + Sheet1.Cells(a, 24) + "/" +Sheet1.Cells(a, 25)
  Sheet2.Cells(c + 12, 2) = "Note: " +Sheet1.Cells(a, 13)
   With Sheet2  'applicaton
       .Range(.Cells(c,2), .Cells(c+ 12, 2)).RowHeight = 12         'Setheight for rows
       .Range(.Cells(c,2), .Cells(c+ 12, 2)).ColumnWidth = 42       'Setwidth for columns
       .Range(.Cells(c,2), .Cells(c+ 12, 2)).Font.Name = "Arial"
       .Range(.Cells(c,2), .Cells(c+ 12, 2)).Font.Size = 11          'Size
       .Range(.Cells(c,2), .Cells(c+ 12, 2)).HorizontalAlignment = xlGeneral
       .Range(.Cells(c,2), .Cells(c+ 12, 2)).VerticalAlignment = xlCenter
       .Range(.Cells(c,2), .Cells(c+ 12, 2)).WrapText = False
       .Range(.Cells(c,2), .Cells(c+ 12, 2)).Orientation = 0
       .Range(.Cells(c,2), .Cells(c+ 12, 2)).AddIndent = False
       .Range(.Cells(c,2), .Cells(c+ 12, 2)).IndentLevel = 0
       .Range(.Cells(c,2), .Cells(c+ 12, 2)).ShrinkToFit = True
       .Range(.Cells(c,2), .Cells(c+ 12, 2)).ReadingOrder = xlContext
       .Range(.Cells(c,2), .Cells(c+ 12, 2)).MergeCells = False
   End With
   With Sheet2.Cells(c, 2)  'Adjusting the label, right
       .Font.Name= "Arial" 'Font
       .Font.Size= 12     'Size
       .Font.Bold= True   'Alignment
       .HorizontalAlignment= xlCenter
       .VerticalAlignment= xlCenter
       .WrapText= False
       .Orientation= 0
       .AddIndent= False
       .IndentLevel= 0
       .ShrinkToFit= True
       .ReadingOrder= xlContext
       .MergeCells= False
   End With
   With Sheet2.Cells(c + 1, 2)            'Formatthe subtitle
       .HorizontalAlignment= xlCenter
       .VerticalAlignment= xlCenter
       .Font.Name= "Times New Roman"   'Font
       .Font.Size= 12                  'Size
   End With
  End If
 d =d + 1
 Next b
   If f = 13 And c > 1 Then
                      Sheet2.HPageBreaks.AddBefore:=Sheet2.Cells(c, 1)
   End If
 End If
Next a
   With Sheet2.PageSetup
       .LeftMargin= Application.InchesToPoints(0.5)
       .RightMargin= Application.InchesToPoints(0.5)
       .TopMargin= Application.InchesToPoints(0.5)
       .BottomMargin= Application.InchesToPoints(0.5)
       .HeaderMargin= Application.InchesToPoints(0.5)
       .FooterMargin= Application.InchesToPoints(0.5)
       .PrintHeadings = False
       .PrintGridlines= False
       .PrintNotes= False
       .CenterHorizontally= False
       .CenterVertically= False
       .Orientation= xlPortrait
       .Draft= False
       .PaperSize= xlPaperA4                  ' xlPaperA4:A4
       .FirstPageNumber= xlAutomatic
       .Order= xlDownThenOver
       .BlackAndWhite= False
       .Zoom= 100
       .FitToPagesWide= 1
       .FitToPagesTall= 1
       .PrintErrors= xlPrintErrorsDisplayed
       End With
Sheet2.PrintPreview